diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 1029 |
1 files changed, 391 insertions, 638 deletions
diff --git a/src/alloc.c b/src/alloc.c index fb16b7d7511..cce0fff4fd4 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | /* Storage allocation and gc for GNU Emacs Lisp interpreter. | 1 | /* Storage allocation and gc for GNU Emacs Lisp interpreter. |
| 2 | 2 | ||
| 3 | Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012 | 3 | Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software |
| 4 | Free Software Foundation, Inc. | 4 | Foundation, Inc. |
| 5 | 5 | ||
| 6 | This file is part of GNU Emacs. | 6 | This file is part of GNU Emacs. |
| 7 | 7 | ||
| @@ -24,10 +24,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 24 | 24 | ||
| 25 | #include <stdio.h> | 25 | #include <stdio.h> |
| 26 | #include <limits.h> /* For CHAR_BIT. */ | 26 | #include <limits.h> /* For CHAR_BIT. */ |
| 27 | #include <setjmp.h> | ||
| 28 | 27 | ||
| 29 | #ifdef ENABLE_CHECKING | 28 | #ifdef ENABLE_CHECKING |
| 30 | #include <signal.h> /* For SIGABRT. */ | 29 | #include <signal.h> /* For SIGABRT. */ |
| 31 | #endif | 30 | #endif |
| 32 | 31 | ||
| 33 | #ifdef HAVE_PTHREAD | 32 | #ifdef HAVE_PTHREAD |
| @@ -45,7 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 45 | #include "frame.h" | 44 | #include "frame.h" |
| 46 | #include "blockinput.h" | 45 | #include "blockinput.h" |
| 47 | #include "termhooks.h" /* For struct terminal. */ | 46 | #include "termhooks.h" /* For struct terminal. */ |
| 48 | #include <setjmp.h> | 47 | |
| 49 | #include <verify.h> | 48 | #include <verify.h> |
| 50 | 49 | ||
| 51 | /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. | 50 | /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. |
| @@ -64,10 +63,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 64 | #endif | 63 | #endif |
| 65 | 64 | ||
| 66 | #include <unistd.h> | 65 | #include <unistd.h> |
| 67 | #ifndef HAVE_UNISTD_H | ||
| 68 | extern void *sbrk (); | ||
| 69 | #endif | ||
| 70 | |||
| 71 | #include <fcntl.h> | 66 | #include <fcntl.h> |
| 72 | 67 | ||
| 73 | #ifdef USE_GTK | 68 | #ifdef USE_GTK |
| @@ -75,6 +70,7 @@ extern void *sbrk (); | |||
| 75 | #endif | 70 | #endif |
| 76 | #ifdef WINDOWSNT | 71 | #ifdef WINDOWSNT |
| 77 | #include "w32.h" | 72 | #include "w32.h" |
| 73 | #include "w32heap.h" /* for sbrk */ | ||
| 78 | #endif | 74 | #endif |
| 79 | 75 | ||
| 80 | #ifdef DOUG_LEA_MALLOC | 76 | #ifdef DOUG_LEA_MALLOC |
| @@ -86,66 +82,8 @@ extern void *sbrk (); | |||
| 86 | 82 | ||
| 87 | #define MMAP_MAX_AREAS 100000000 | 83 | #define MMAP_MAX_AREAS 100000000 |
| 88 | 84 | ||
| 89 | #else /* not DOUG_LEA_MALLOC */ | ||
| 90 | |||
| 91 | /* The following come from gmalloc.c. */ | ||
| 92 | |||
| 93 | extern size_t _bytes_used; | ||
| 94 | extern size_t __malloc_extra_blocks; | ||
| 95 | extern void *_malloc_internal (size_t); | ||
| 96 | extern void _free_internal (void *); | ||
| 97 | |||
| 98 | #endif /* not DOUG_LEA_MALLOC */ | 85 | #endif /* not DOUG_LEA_MALLOC */ |
| 99 | 86 | ||
| 100 | #if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT | ||
| 101 | #ifdef HAVE_PTHREAD | ||
| 102 | |||
| 103 | /* When GTK uses the file chooser dialog, different backends can be loaded | ||
| 104 | dynamically. One such a backend is the Gnome VFS backend that gets loaded | ||
| 105 | if you run Gnome. That backend creates several threads and also allocates | ||
| 106 | memory with malloc. | ||
| 107 | |||
| 108 | Also, gconf and gsettings may create several threads. | ||
| 109 | |||
| 110 | If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_* | ||
| 111 | functions below are called from malloc, there is a chance that one | ||
| 112 | of these threads preempts the Emacs main thread and the hook variables | ||
| 113 | end up in an inconsistent state. So we have a mutex to prevent that (note | ||
| 114 | that the backend handles concurrent access to malloc within its own threads | ||
| 115 | but Emacs code running in the main thread is not included in that control). | ||
| 116 | |||
| 117 | When UNBLOCK_INPUT is called, reinvoke_input_signal may be called. If this | ||
| 118 | happens in one of the backend threads we will have two threads that tries | ||
| 119 | to run Emacs code at once, and the code is not prepared for that. | ||
| 120 | To prevent that, we only call BLOCK/UNBLOCK from the main thread. */ | ||
| 121 | |||
| 122 | static pthread_mutex_t alloc_mutex; | ||
| 123 | |||
| 124 | #define BLOCK_INPUT_ALLOC \ | ||
| 125 | do \ | ||
| 126 | { \ | ||
| 127 | if (pthread_equal (pthread_self (), main_thread)) \ | ||
| 128 | BLOCK_INPUT; \ | ||
| 129 | pthread_mutex_lock (&alloc_mutex); \ | ||
| 130 | } \ | ||
| 131 | while (0) | ||
| 132 | #define UNBLOCK_INPUT_ALLOC \ | ||
| 133 | do \ | ||
| 134 | { \ | ||
| 135 | pthread_mutex_unlock (&alloc_mutex); \ | ||
| 136 | if (pthread_equal (pthread_self (), main_thread)) \ | ||
| 137 | UNBLOCK_INPUT; \ | ||
| 138 | } \ | ||
| 139 | while (0) | ||
| 140 | |||
| 141 | #else /* ! defined HAVE_PTHREAD */ | ||
| 142 | |||
| 143 | #define BLOCK_INPUT_ALLOC BLOCK_INPUT | ||
| 144 | #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT | ||
| 145 | |||
| 146 | #endif /* ! defined HAVE_PTHREAD */ | ||
| 147 | #endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */ | ||
| 148 | |||
| 149 | /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer | 87 | /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer |
| 150 | to a struct Lisp_String. */ | 88 | to a struct Lisp_String. */ |
| 151 | 89 | ||
| @@ -204,10 +142,6 @@ static char *spare_memory[7]; | |||
| 204 | 142 | ||
| 205 | #define SPARE_MEMORY (1 << 14) | 143 | #define SPARE_MEMORY (1 << 14) |
| 206 | 144 | ||
| 207 | /* Number of extra blocks malloc should get when it needs more core. */ | ||
| 208 | |||
| 209 | static int malloc_hysteresis; | ||
| 210 | |||
| 211 | /* Initialize it to a nonzero value to force it into data space | 145 | /* Initialize it to a nonzero value to force it into data space |
| 212 | (rather than bss space). That way unexec will remap it into text | 146 | (rather than bss space). That way unexec will remap it into text |
| 213 | space (pure), on some systems. We have not implemented the | 147 | space (pure), on some systems. We have not implemented the |
| @@ -268,32 +202,29 @@ static Lisp_Object Qintervals; | |||
| 268 | static Lisp_Object Qbuffers; | 202 | static Lisp_Object Qbuffers; |
| 269 | static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; | 203 | static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; |
| 270 | static Lisp_Object Qgc_cons_threshold; | 204 | static Lisp_Object Qgc_cons_threshold; |
| 205 | Lisp_Object Qautomatic_gc; | ||
| 271 | Lisp_Object Qchar_table_extra_slots; | 206 | Lisp_Object Qchar_table_extra_slots; |
| 272 | 207 | ||
| 273 | /* Hook run after GC has finished. */ | 208 | /* Hook run after GC has finished. */ |
| 274 | 209 | ||
| 275 | static Lisp_Object Qpost_gc_hook; | 210 | static Lisp_Object Qpost_gc_hook; |
| 276 | 211 | ||
| 212 | static void free_save_value (Lisp_Object); | ||
| 277 | static void mark_terminals (void); | 213 | static void mark_terminals (void); |
| 278 | static void gc_sweep (void); | 214 | static void gc_sweep (void); |
| 279 | static Lisp_Object make_pure_vector (ptrdiff_t); | 215 | static Lisp_Object make_pure_vector (ptrdiff_t); |
| 280 | static void mark_glyph_matrix (struct glyph_matrix *); | ||
| 281 | static void mark_face_cache (struct face_cache *); | ||
| 282 | static void mark_buffer (struct buffer *); | 216 | static void mark_buffer (struct buffer *); |
| 283 | 217 | ||
| 284 | #if !defined REL_ALLOC || defined SYSTEM_MALLOC | 218 | #if !defined REL_ALLOC || defined SYSTEM_MALLOC |
| 285 | static void refill_memory_reserve (void); | 219 | static void refill_memory_reserve (void); |
| 286 | #endif | 220 | #endif |
| 287 | static struct Lisp_String *allocate_string (void); | ||
| 288 | static void compact_small_strings (void); | 221 | static void compact_small_strings (void); |
| 289 | static void free_large_strings (void); | 222 | static void free_large_strings (void); |
| 290 | static void sweep_strings (void); | ||
| 291 | static void free_misc (Lisp_Object); | ||
| 292 | extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; | 223 | extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; |
| 293 | 224 | ||
| 294 | /* When scanning the C stack for live Lisp objects, Emacs keeps track | 225 | /* When scanning the C stack for live Lisp objects, Emacs keeps track of |
| 295 | of what memory allocated via lisp_malloc is intended for what | 226 | what memory allocated via lisp_malloc and lisp_align_malloc is intended |
| 296 | purpose. This enumeration specifies the type of memory. */ | 227 | for what purpose. This enumeration specifies the type of memory. */ |
| 297 | 228 | ||
| 298 | enum mem_type | 229 | enum mem_type |
| 299 | { | 230 | { |
| @@ -304,10 +235,9 @@ enum mem_type | |||
| 304 | MEM_TYPE_MISC, | 235 | MEM_TYPE_MISC, |
| 305 | MEM_TYPE_SYMBOL, | 236 | MEM_TYPE_SYMBOL, |
| 306 | MEM_TYPE_FLOAT, | 237 | MEM_TYPE_FLOAT, |
| 307 | /* We used to keep separate mem_types for subtypes of vectors such as | 238 | /* Since all non-bool pseudovectors are small enough to be |
| 308 | process, hash_table, frame, terminal, and window, but we never made | 239 | allocated from vector blocks, this memory type denotes |
| 309 | use of the distinction, so it only caused source-code complexity | 240 | large regular vectors and large bool pseudovectors. */ |
| 310 | and runtime slowdown. Minor but pointless. */ | ||
| 311 | MEM_TYPE_VECTORLIKE, | 241 | MEM_TYPE_VECTORLIKE, |
| 312 | /* Special type to denote vector blocks. */ | 242 | /* Special type to denote vector blocks. */ |
| 313 | MEM_TYPE_VECTOR_BLOCK, | 243 | MEM_TYPE_VECTOR_BLOCK, |
| @@ -315,9 +245,6 @@ enum mem_type | |||
| 315 | MEM_TYPE_SPARE | 245 | MEM_TYPE_SPARE |
| 316 | }; | 246 | }; |
| 317 | 247 | ||
| 318 | static void *lisp_malloc (size_t, enum mem_type); | ||
| 319 | |||
| 320 | |||
| 321 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK | 248 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
| 322 | 249 | ||
| 323 | #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES | 250 | #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
| @@ -396,32 +323,14 @@ static void *min_heap_address, *max_heap_address; | |||
| 396 | static struct mem_node mem_z; | 323 | static struct mem_node mem_z; |
| 397 | #define MEM_NIL &mem_z | 324 | #define MEM_NIL &mem_z |
| 398 | 325 | ||
| 399 | static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t); | ||
| 400 | static void lisp_free (void *); | ||
| 401 | static void mark_stack (void); | ||
| 402 | static bool live_vector_p (struct mem_node *, void *); | ||
| 403 | static bool live_buffer_p (struct mem_node *, void *); | ||
| 404 | static bool live_string_p (struct mem_node *, void *); | ||
| 405 | static bool live_cons_p (struct mem_node *, void *); | ||
| 406 | static bool live_symbol_p (struct mem_node *, void *); | ||
| 407 | static bool live_float_p (struct mem_node *, void *); | ||
| 408 | static bool live_misc_p (struct mem_node *, void *); | ||
| 409 | static void mark_maybe_object (Lisp_Object); | ||
| 410 | static void mark_memory (void *, void *); | ||
| 411 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK | 326 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
| 412 | static void mem_init (void); | ||
| 413 | static struct mem_node *mem_insert (void *, void *, enum mem_type); | 327 | static struct mem_node *mem_insert (void *, void *, enum mem_type); |
| 414 | static void mem_insert_fixup (struct mem_node *); | 328 | static void mem_insert_fixup (struct mem_node *); |
| 415 | #endif | ||
| 416 | static void mem_rotate_left (struct mem_node *); | 329 | static void mem_rotate_left (struct mem_node *); |
| 417 | static void mem_rotate_right (struct mem_node *); | 330 | static void mem_rotate_right (struct mem_node *); |
| 418 | static void mem_delete (struct mem_node *); | 331 | static void mem_delete (struct mem_node *); |
| 419 | static void mem_delete_fixup (struct mem_node *); | 332 | static void mem_delete_fixup (struct mem_node *); |
| 420 | static inline struct mem_node *mem_find (void *); | 333 | static struct mem_node *mem_find (void *); |
| 421 | |||
| 422 | |||
| 423 | #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS | ||
| 424 | static void check_gcpros (void); | ||
| 425 | #endif | 334 | #endif |
| 426 | 335 | ||
| 427 | #endif /* GC_MARK_STACK || GC_MALLOC_CHECK */ | 336 | #endif /* GC_MARK_STACK || GC_MALLOC_CHECK */ |
| @@ -437,7 +346,7 @@ struct gcpro *gcprolist; | |||
| 437 | /* Addresses of staticpro'd variables. Initialize it to a nonzero | 346 | /* Addresses of staticpro'd variables. Initialize it to a nonzero |
| 438 | value; otherwise some compilers put it into BSS. */ | 347 | value; otherwise some compilers put it into BSS. */ |
| 439 | 348 | ||
| 440 | #define NSTATICS 0x650 | 349 | #define NSTATICS 0x800 |
| 441 | static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; | 350 | static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; |
| 442 | 351 | ||
| 443 | /* Index of next unused slot in staticvec. */ | 352 | /* Index of next unused slot in staticvec. */ |
| @@ -495,11 +404,11 @@ buffer_memory_full (ptrdiff_t nbytes) | |||
| 495 | 404 | ||
| 496 | #ifndef REL_ALLOC | 405 | #ifndef REL_ALLOC |
| 497 | memory_full (nbytes); | 406 | memory_full (nbytes); |
| 498 | #endif | 407 | #else |
| 499 | |||
| 500 | /* This used to call error, but if we've run out of memory, we could | 408 | /* This used to call error, but if we've run out of memory, we could |
| 501 | get infinite recursion trying to build the string. */ | 409 | get infinite recursion trying to build the string. */ |
| 502 | xsignal (Qnil, Vmemory_signal_data); | 410 | xsignal (Qnil, Vmemory_signal_data); |
| 411 | #endif | ||
| 503 | } | 412 | } |
| 504 | 413 | ||
| 505 | /* A common multiple of the positive integers A and B. Ideally this | 414 | /* A common multiple of the positive integers A and B. Ideally this |
| @@ -586,39 +495,17 @@ xmalloc_get_size (unsigned char *ptr) | |||
| 586 | } | 495 | } |
| 587 | 496 | ||
| 588 | 497 | ||
| 589 | /* The call depth in overrun_check functions. For example, this might happen: | ||
| 590 | xmalloc() | ||
| 591 | overrun_check_malloc() | ||
| 592 | -> malloc -> (via hook)_-> emacs_blocked_malloc | ||
| 593 | -> overrun_check_malloc | ||
| 594 | call malloc (hooks are NULL, so real malloc is called). | ||
| 595 | malloc returns 10000. | ||
| 596 | add overhead, return 10016. | ||
| 597 | <- (back in overrun_check_malloc) | ||
| 598 | add overhead again, return 10032 | ||
| 599 | xmalloc returns 10032. | ||
| 600 | |||
| 601 | (time passes). | ||
| 602 | |||
| 603 | xfree(10032) | ||
| 604 | overrun_check_free(10032) | ||
| 605 | decrease overhead | ||
| 606 | free(10016) <- crash, because 10000 is the original pointer. */ | ||
| 607 | |||
| 608 | static ptrdiff_t check_depth; | ||
| 609 | |||
| 610 | /* Like malloc, but wraps allocated block with header and trailer. */ | 498 | /* Like malloc, but wraps allocated block with header and trailer. */ |
| 611 | 499 | ||
| 612 | static void * | 500 | static void * |
| 613 | overrun_check_malloc (size_t size) | 501 | overrun_check_malloc (size_t size) |
| 614 | { | 502 | { |
| 615 | register unsigned char *val; | 503 | register unsigned char *val; |
| 616 | int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0; | 504 | if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size) |
| 617 | if (SIZE_MAX - overhead < size) | ||
| 618 | emacs_abort (); | 505 | emacs_abort (); |
| 619 | 506 | ||
| 620 | val = malloc (size + overhead); | 507 | val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD); |
| 621 | if (val && check_depth == 1) | 508 | if (val) |
| 622 | { | 509 | { |
| 623 | memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); | 510 | memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); |
| 624 | val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE; | 511 | val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE; |
| @@ -626,7 +513,6 @@ overrun_check_malloc (size_t size) | |||
| 626 | memcpy (val + size, xmalloc_overrun_check_trailer, | 513 | memcpy (val + size, xmalloc_overrun_check_trailer, |
| 627 | XMALLOC_OVERRUN_CHECK_SIZE); | 514 | XMALLOC_OVERRUN_CHECK_SIZE); |
| 628 | } | 515 | } |
| 629 | --check_depth; | ||
| 630 | return val; | 516 | return val; |
| 631 | } | 517 | } |
| 632 | 518 | ||
| @@ -638,12 +524,10 @@ static void * | |||
| 638 | overrun_check_realloc (void *block, size_t size) | 524 | overrun_check_realloc (void *block, size_t size) |
| 639 | { | 525 | { |
| 640 | register unsigned char *val = (unsigned char *) block; | 526 | register unsigned char *val = (unsigned char *) block; |
| 641 | int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0; | 527 | if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size) |
| 642 | if (SIZE_MAX - overhead < size) | ||
| 643 | emacs_abort (); | 528 | emacs_abort (); |
| 644 | 529 | ||
| 645 | if (val | 530 | if (val |
| 646 | && check_depth == 1 | ||
| 647 | && memcmp (xmalloc_overrun_check_header, | 531 | && memcmp (xmalloc_overrun_check_header, |
| 648 | val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE, | 532 | val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE, |
| 649 | XMALLOC_OVERRUN_CHECK_SIZE) == 0) | 533 | XMALLOC_OVERRUN_CHECK_SIZE) == 0) |
| @@ -657,9 +541,9 @@ overrun_check_realloc (void *block, size_t size) | |||
| 657 | memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE); | 541 | memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE); |
| 658 | } | 542 | } |
| 659 | 543 | ||
| 660 | val = realloc (val, size + overhead); | 544 | val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD); |
| 661 | 545 | ||
| 662 | if (val && check_depth == 1) | 546 | if (val) |
| 663 | { | 547 | { |
| 664 | memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); | 548 | memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); |
| 665 | val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE; | 549 | val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE; |
| @@ -667,7 +551,6 @@ overrun_check_realloc (void *block, size_t size) | |||
| 667 | memcpy (val + size, xmalloc_overrun_check_trailer, | 551 | memcpy (val + size, xmalloc_overrun_check_trailer, |
| 668 | XMALLOC_OVERRUN_CHECK_SIZE); | 552 | XMALLOC_OVERRUN_CHECK_SIZE); |
| 669 | } | 553 | } |
| 670 | --check_depth; | ||
| 671 | return val; | 554 | return val; |
| 672 | } | 555 | } |
| 673 | 556 | ||
| @@ -678,9 +561,7 @@ overrun_check_free (void *block) | |||
| 678 | { | 561 | { |
| 679 | unsigned char *val = (unsigned char *) block; | 562 | unsigned char *val = (unsigned char *) block; |
| 680 | 563 | ||
| 681 | ++check_depth; | ||
| 682 | if (val | 564 | if (val |
| 683 | && check_depth == 1 | ||
| 684 | && memcmp (xmalloc_overrun_check_header, | 565 | && memcmp (xmalloc_overrun_check_header, |
| 685 | val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE, | 566 | val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE, |
| 686 | XMALLOC_OVERRUN_CHECK_SIZE) == 0) | 567 | XMALLOC_OVERRUN_CHECK_SIZE) == 0) |
| @@ -700,7 +581,6 @@ overrun_check_free (void *block) | |||
| 700 | } | 581 | } |
| 701 | 582 | ||
| 702 | free (val); | 583 | free (val); |
| 703 | --check_depth; | ||
| 704 | } | 584 | } |
| 705 | 585 | ||
| 706 | #undef malloc | 586 | #undef malloc |
| @@ -711,16 +591,42 @@ overrun_check_free (void *block) | |||
| 711 | #define free overrun_check_free | 591 | #define free overrun_check_free |
| 712 | #endif | 592 | #endif |
| 713 | 593 | ||
| 714 | #ifdef SYNC_INPUT | 594 | /* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol |
| 715 | /* When using SYNC_INPUT, we don't call malloc from a signal handler, so | 595 | BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger. |
| 716 | there's no need to block input around malloc. */ | 596 | If that variable is set, block input while in one of Emacs's memory |
| 717 | #define MALLOC_BLOCK_INPUT ((void)0) | 597 | allocation functions. There should be no need for this debugging |
| 718 | #define MALLOC_UNBLOCK_INPUT ((void)0) | 598 | option, since signal handlers do not allocate memory, but Emacs |
| 599 | formerly allocated memory in signal handlers and this compile-time | ||
| 600 | option remains as a way to help debug the issue should it rear its | ||
| 601 | ugly head again. */ | ||
| 602 | #ifdef XMALLOC_BLOCK_INPUT_CHECK | ||
| 603 | bool block_input_in_memory_allocators EXTERNALLY_VISIBLE; | ||
| 604 | static void | ||
| 605 | malloc_block_input (void) | ||
| 606 | { | ||
| 607 | if (block_input_in_memory_allocators) | ||
| 608 | block_input (); | ||
| 609 | } | ||
| 610 | static void | ||
| 611 | malloc_unblock_input (void) | ||
| 612 | { | ||
| 613 | if (block_input_in_memory_allocators) | ||
| 614 | unblock_input (); | ||
| 615 | } | ||
| 616 | # define MALLOC_BLOCK_INPUT malloc_block_input () | ||
| 617 | # define MALLOC_UNBLOCK_INPUT malloc_unblock_input () | ||
| 719 | #else | 618 | #else |
| 720 | #define MALLOC_BLOCK_INPUT BLOCK_INPUT | 619 | # define MALLOC_BLOCK_INPUT ((void) 0) |
| 721 | #define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT | 620 | # define MALLOC_UNBLOCK_INPUT ((void) 0) |
| 722 | #endif | 621 | #endif |
| 723 | 622 | ||
| 623 | #define MALLOC_PROBE(size) \ | ||
| 624 | do { \ | ||
| 625 | if (profiler_memory_running) \ | ||
| 626 | malloc_probe (size); \ | ||
| 627 | } while (0) | ||
| 628 | |||
| 629 | |||
| 724 | /* Like malloc but check for no memory and block interrupt input.. */ | 630 | /* Like malloc but check for no memory and block interrupt input.. */ |
| 725 | 631 | ||
| 726 | void * | 632 | void * |
| @@ -734,6 +640,7 @@ xmalloc (size_t size) | |||
| 734 | 640 | ||
| 735 | if (!val && size) | 641 | if (!val && size) |
| 736 | memory_full (size); | 642 | memory_full (size); |
| 643 | MALLOC_PROBE (size); | ||
| 737 | return val; | 644 | return val; |
| 738 | } | 645 | } |
| 739 | 646 | ||
| @@ -751,6 +658,7 @@ xzalloc (size_t size) | |||
| 751 | if (!val && size) | 658 | if (!val && size) |
| 752 | memory_full (size); | 659 | memory_full (size); |
| 753 | memset (val, 0, size); | 660 | memset (val, 0, size); |
| 661 | MALLOC_PROBE (size); | ||
| 754 | return val; | 662 | return val; |
| 755 | } | 663 | } |
| 756 | 664 | ||
| @@ -772,6 +680,7 @@ xrealloc (void *block, size_t size) | |||
| 772 | 680 | ||
| 773 | if (!val && size) | 681 | if (!val && size) |
| 774 | memory_full (size); | 682 | memory_full (size); |
| 683 | MALLOC_PROBE (size); | ||
| 775 | return val; | 684 | return val; |
| 776 | } | 685 | } |
| 777 | 686 | ||
| @@ -787,8 +696,7 @@ xfree (void *block) | |||
| 787 | free (block); | 696 | free (block); |
| 788 | MALLOC_UNBLOCK_INPUT; | 697 | MALLOC_UNBLOCK_INPUT; |
| 789 | /* We don't call refill_memory_reserve here | 698 | /* We don't call refill_memory_reserve here |
| 790 | because that duplicates doing so in emacs_blocked_free | 699 | because in practice the call in r_alloc_free seems to suffice. */ |
| 791 | and the criterion should go there. */ | ||
| 792 | } | 700 | } |
| 793 | 701 | ||
| 794 | 702 | ||
| @@ -835,13 +743,17 @@ xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size) | |||
| 835 | infinity. | 743 | infinity. |
| 836 | 744 | ||
| 837 | If PA is null, then allocate a new array instead of reallocating | 745 | If PA is null, then allocate a new array instead of reallocating |
| 838 | the old one. Thus, to grow an array A without saving its old | 746 | the old one. |
| 839 | contents, invoke xfree (A) immediately followed by xgrowalloc (0, | ||
| 840 | &NITEMS, ...). | ||
| 841 | 747 | ||
| 842 | Block interrupt input as needed. If memory exhaustion occurs, set | 748 | Block interrupt input as needed. If memory exhaustion occurs, set |
| 843 | *NITEMS to zero if PA is null, and signal an error (i.e., do not | 749 | *NITEMS to zero if PA is null, and signal an error (i.e., do not |
| 844 | return). */ | 750 | return). |
| 751 | |||
| 752 | Thus, to grow an array A without saving its old contents, do | ||
| 753 | { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }. | ||
| 754 | The A = NULL avoids a dangling pointer if xpalloc exhausts memory | ||
| 755 | and signals an error, and later this code is reexecuted and | ||
| 756 | attempts to free A. */ | ||
| 845 | 757 | ||
| 846 | void * | 758 | void * |
| 847 | xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min, | 759 | xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min, |
| @@ -890,18 +802,22 @@ xstrdup (const char *s) | |||
| 890 | return p; | 802 | return p; |
| 891 | } | 803 | } |
| 892 | 804 | ||
| 805 | /* Like putenv, but (1) use the equivalent of xmalloc and (2) the | ||
| 806 | argument is a const pointer. */ | ||
| 807 | |||
| 808 | void | ||
| 809 | xputenv (char const *string) | ||
| 810 | { | ||
| 811 | if (putenv ((char *) string) != 0) | ||
| 812 | memory_full (0); | ||
| 813 | } | ||
| 893 | 814 | ||
| 894 | /* Unwind for SAFE_ALLOCA */ | 815 | /* Unwind for SAFE_ALLOCA */ |
| 895 | 816 | ||
| 896 | Lisp_Object | 817 | Lisp_Object |
| 897 | safe_alloca_unwind (Lisp_Object arg) | 818 | safe_alloca_unwind (Lisp_Object arg) |
| 898 | { | 819 | { |
| 899 | register struct Lisp_Save_Value *p = XSAVE_VALUE (arg); | 820 | free_save_value (arg); |
| 900 | |||
| 901 | p->dogc = 0; | ||
| 902 | xfree (p->pointer); | ||
| 903 | p->pointer = 0; | ||
| 904 | free_misc (arg); | ||
| 905 | return Qnil; | 821 | return Qnil; |
| 906 | } | 822 | } |
| 907 | 823 | ||
| @@ -911,7 +827,7 @@ void * | |||
| 911 | record_xmalloc (size_t size) | 827 | record_xmalloc (size_t size) |
| 912 | { | 828 | { |
| 913 | void *p = xmalloc (size); | 829 | void *p = xmalloc (size); |
| 914 | record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0)); | 830 | record_unwind_protect (safe_alloca_unwind, make_save_pointer (p)); |
| 915 | return p; | 831 | return p; |
| 916 | } | 832 | } |
| 917 | 833 | ||
| @@ -962,6 +878,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) | |||
| 962 | MALLOC_UNBLOCK_INPUT; | 878 | MALLOC_UNBLOCK_INPUT; |
| 963 | if (!val && nbytes) | 879 | if (!val && nbytes) |
| 964 | memory_full (nbytes); | 880 | memory_full (nbytes); |
| 881 | MALLOC_PROBE (nbytes); | ||
| 965 | return val; | 882 | return val; |
| 966 | } | 883 | } |
| 967 | 884 | ||
| @@ -1167,6 +1084,8 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) | |||
| 1167 | 1084 | ||
| 1168 | MALLOC_UNBLOCK_INPUT; | 1085 | MALLOC_UNBLOCK_INPUT; |
| 1169 | 1086 | ||
| 1087 | MALLOC_PROBE (nbytes); | ||
| 1088 | |||
| 1170 | eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); | 1089 | eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); |
| 1171 | return val; | 1090 | return val; |
| 1172 | } | 1091 | } |
| @@ -1215,256 +1134,6 @@ lisp_align_free (void *block) | |||
| 1215 | } | 1134 | } |
| 1216 | 1135 | ||
| 1217 | 1136 | ||
| 1218 | #ifndef SYSTEM_MALLOC | ||
| 1219 | |||
| 1220 | /* Arranging to disable input signals while we're in malloc. | ||
| 1221 | |||
| 1222 | This only works with GNU malloc. To help out systems which can't | ||
| 1223 | use GNU malloc, all the calls to malloc, realloc, and free | ||
| 1224 | elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT | ||
| 1225 | pair; unfortunately, we have no idea what C library functions | ||
| 1226 | might call malloc, so we can't really protect them unless you're | ||
| 1227 | using GNU malloc. Fortunately, most of the major operating systems | ||
| 1228 | can use GNU malloc. */ | ||
| 1229 | |||
| 1230 | #ifndef SYNC_INPUT | ||
| 1231 | /* When using SYNC_INPUT, we don't call malloc from a signal handler, so | ||
| 1232 | there's no need to block input around malloc. */ | ||
| 1233 | |||
| 1234 | #ifndef DOUG_LEA_MALLOC | ||
| 1235 | extern void * (*__malloc_hook) (size_t, const void *); | ||
| 1236 | extern void * (*__realloc_hook) (void *, size_t, const void *); | ||
| 1237 | extern void (*__free_hook) (void *, const void *); | ||
| 1238 | /* Else declared in malloc.h, perhaps with an extra arg. */ | ||
| 1239 | #endif /* DOUG_LEA_MALLOC */ | ||
| 1240 | static void * (*old_malloc_hook) (size_t, const void *); | ||
| 1241 | static void * (*old_realloc_hook) (void *, size_t, const void*); | ||
| 1242 | static void (*old_free_hook) (void*, const void*); | ||
| 1243 | |||
| 1244 | #ifdef DOUG_LEA_MALLOC | ||
| 1245 | # define BYTES_USED (mallinfo ().uordblks) | ||
| 1246 | #else | ||
| 1247 | # define BYTES_USED _bytes_used | ||
| 1248 | #endif | ||
| 1249 | |||
| 1250 | #ifdef GC_MALLOC_CHECK | ||
| 1251 | static bool dont_register_blocks; | ||
| 1252 | #endif | ||
| 1253 | |||
| 1254 | static size_t bytes_used_when_reconsidered; | ||
| 1255 | |||
| 1256 | /* Value of _bytes_used, when spare_memory was freed. */ | ||
| 1257 | |||
| 1258 | static size_t bytes_used_when_full; | ||
| 1259 | |||
| 1260 | /* This function is used as the hook for free to call. */ | ||
| 1261 | |||
| 1262 | static void | ||
| 1263 | emacs_blocked_free (void *ptr, const void *ptr2) | ||
| 1264 | { | ||
| 1265 | BLOCK_INPUT_ALLOC; | ||
| 1266 | |||
| 1267 | #ifdef GC_MALLOC_CHECK | ||
| 1268 | if (ptr) | ||
| 1269 | { | ||
| 1270 | struct mem_node *m; | ||
| 1271 | |||
| 1272 | m = mem_find (ptr); | ||
| 1273 | if (m == MEM_NIL || m->start != ptr) | ||
| 1274 | { | ||
| 1275 | fprintf (stderr, | ||
| 1276 | "Freeing `%p' which wasn't allocated with malloc\n", ptr); | ||
| 1277 | emacs_abort (); | ||
| 1278 | } | ||
| 1279 | else | ||
| 1280 | { | ||
| 1281 | /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */ | ||
| 1282 | mem_delete (m); | ||
| 1283 | } | ||
| 1284 | } | ||
| 1285 | #endif /* GC_MALLOC_CHECK */ | ||
| 1286 | |||
| 1287 | __free_hook = old_free_hook; | ||
| 1288 | free (ptr); | ||
| 1289 | |||
| 1290 | /* If we released our reserve (due to running out of memory), | ||
| 1291 | and we have a fair amount free once again, | ||
| 1292 | try to set aside another reserve in case we run out once more. */ | ||
| 1293 | if (! NILP (Vmemory_full) | ||
| 1294 | /* Verify there is enough space that even with the malloc | ||
| 1295 | hysteresis this call won't run out again. | ||
| 1296 | The code here is correct as long as SPARE_MEMORY | ||
| 1297 | is substantially larger than the block size malloc uses. */ | ||
| 1298 | && (bytes_used_when_full | ||
| 1299 | > ((bytes_used_when_reconsidered = BYTES_USED) | ||
| 1300 | + max (malloc_hysteresis, 4) * SPARE_MEMORY))) | ||
| 1301 | refill_memory_reserve (); | ||
| 1302 | |||
| 1303 | __free_hook = emacs_blocked_free; | ||
| 1304 | UNBLOCK_INPUT_ALLOC; | ||
| 1305 | } | ||
| 1306 | |||
| 1307 | |||
| 1308 | /* This function is the malloc hook that Emacs uses. */ | ||
| 1309 | |||
| 1310 | static void * | ||
| 1311 | emacs_blocked_malloc (size_t size, const void *ptr) | ||
| 1312 | { | ||
| 1313 | void *value; | ||
| 1314 | |||
| 1315 | BLOCK_INPUT_ALLOC; | ||
| 1316 | __malloc_hook = old_malloc_hook; | ||
| 1317 | #ifdef DOUG_LEA_MALLOC | ||
| 1318 | /* Segfaults on my system. --lorentey */ | ||
| 1319 | /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */ | ||
| 1320 | #else | ||
| 1321 | __malloc_extra_blocks = malloc_hysteresis; | ||
| 1322 | #endif | ||
| 1323 | |||
| 1324 | value = malloc (size); | ||
| 1325 | |||
| 1326 | #ifdef GC_MALLOC_CHECK | ||
| 1327 | { | ||
| 1328 | struct mem_node *m = mem_find (value); | ||
| 1329 | if (m != MEM_NIL) | ||
| 1330 | { | ||
| 1331 | fprintf (stderr, "Malloc returned %p which is already in use\n", | ||
| 1332 | value); | ||
| 1333 | fprintf (stderr, "Region in use is %p...%p, %td bytes, type %d\n", | ||
| 1334 | m->start, m->end, (char *) m->end - (char *) m->start, | ||
| 1335 | m->type); | ||
| 1336 | emacs_abort (); | ||
| 1337 | } | ||
| 1338 | |||
| 1339 | if (!dont_register_blocks) | ||
| 1340 | { | ||
| 1341 | mem_insert (value, (char *) value + max (1, size), allocated_mem_type); | ||
| 1342 | allocated_mem_type = MEM_TYPE_NON_LISP; | ||
| 1343 | } | ||
| 1344 | } | ||
| 1345 | #endif /* GC_MALLOC_CHECK */ | ||
| 1346 | |||
| 1347 | __malloc_hook = emacs_blocked_malloc; | ||
| 1348 | UNBLOCK_INPUT_ALLOC; | ||
| 1349 | |||
| 1350 | /* fprintf (stderr, "%p malloc\n", value); */ | ||
| 1351 | return value; | ||
| 1352 | } | ||
| 1353 | |||
| 1354 | |||
| 1355 | /* This function is the realloc hook that Emacs uses. */ | ||
| 1356 | |||
| 1357 | static void * | ||
| 1358 | emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2) | ||
| 1359 | { | ||
| 1360 | void *value; | ||
| 1361 | |||
| 1362 | BLOCK_INPUT_ALLOC; | ||
| 1363 | __realloc_hook = old_realloc_hook; | ||
| 1364 | |||
| 1365 | #ifdef GC_MALLOC_CHECK | ||
| 1366 | if (ptr) | ||
| 1367 | { | ||
| 1368 | struct mem_node *m = mem_find (ptr); | ||
| 1369 | if (m == MEM_NIL || m->start != ptr) | ||
| 1370 | { | ||
| 1371 | fprintf (stderr, | ||
| 1372 | "Realloc of %p which wasn't allocated with malloc\n", | ||
| 1373 | ptr); | ||
| 1374 | emacs_abort (); | ||
| 1375 | } | ||
| 1376 | |||
| 1377 | mem_delete (m); | ||
| 1378 | } | ||
| 1379 | |||
| 1380 | /* fprintf (stderr, "%p -> realloc\n", ptr); */ | ||
| 1381 | |||
| 1382 | /* Prevent malloc from registering blocks. */ | ||
| 1383 | dont_register_blocks = 1; | ||
| 1384 | #endif /* GC_MALLOC_CHECK */ | ||
| 1385 | |||
| 1386 | value = realloc (ptr, size); | ||
| 1387 | |||
| 1388 | #ifdef GC_MALLOC_CHECK | ||
| 1389 | dont_register_blocks = 0; | ||
| 1390 | |||
| 1391 | { | ||
| 1392 | struct mem_node *m = mem_find (value); | ||
| 1393 | if (m != MEM_NIL) | ||
| 1394 | { | ||
| 1395 | fprintf (stderr, "Realloc returns memory that is already in use\n"); | ||
| 1396 | emacs_abort (); | ||
| 1397 | } | ||
| 1398 | |||
| 1399 | /* Can't handle zero size regions in the red-black tree. */ | ||
| 1400 | mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP); | ||
| 1401 | } | ||
| 1402 | |||
| 1403 | /* fprintf (stderr, "%p <- realloc\n", value); */ | ||
| 1404 | #endif /* GC_MALLOC_CHECK */ | ||
| 1405 | |||
| 1406 | __realloc_hook = emacs_blocked_realloc; | ||
| 1407 | UNBLOCK_INPUT_ALLOC; | ||
| 1408 | |||
| 1409 | return value; | ||
| 1410 | } | ||
| 1411 | |||
| 1412 | |||
| 1413 | #ifdef HAVE_PTHREAD | ||
| 1414 | /* Called from Fdump_emacs so that when the dumped Emacs starts, it has a | ||
| 1415 | normal malloc. Some thread implementations need this as they call | ||
| 1416 | malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then | ||
| 1417 | calls malloc because it is the first call, and we have an endless loop. */ | ||
| 1418 | |||
| 1419 | void | ||
| 1420 | reset_malloc_hooks (void) | ||
| 1421 | { | ||
| 1422 | __free_hook = old_free_hook; | ||
| 1423 | __malloc_hook = old_malloc_hook; | ||
| 1424 | __realloc_hook = old_realloc_hook; | ||
| 1425 | } | ||
| 1426 | #endif /* HAVE_PTHREAD */ | ||
| 1427 | |||
| 1428 | |||
| 1429 | /* Called from main to set up malloc to use our hooks. */ | ||
| 1430 | |||
| 1431 | void | ||
| 1432 | uninterrupt_malloc (void) | ||
| 1433 | { | ||
| 1434 | #ifdef HAVE_PTHREAD | ||
| 1435 | #ifdef DOUG_LEA_MALLOC | ||
| 1436 | pthread_mutexattr_t attr; | ||
| 1437 | |||
| 1438 | /* GLIBC has a faster way to do this, but let's keep it portable. | ||
| 1439 | This is according to the Single UNIX Specification. */ | ||
| 1440 | pthread_mutexattr_init (&attr); | ||
| 1441 | pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE); | ||
| 1442 | pthread_mutex_init (&alloc_mutex, &attr); | ||
| 1443 | #else /* !DOUG_LEA_MALLOC */ | ||
| 1444 | /* Some systems such as Solaris 2.6 don't have a recursive mutex, | ||
| 1445 | and the bundled gmalloc.c doesn't require it. */ | ||
| 1446 | pthread_mutex_init (&alloc_mutex, NULL); | ||
| 1447 | #endif /* !DOUG_LEA_MALLOC */ | ||
| 1448 | #endif /* HAVE_PTHREAD */ | ||
| 1449 | |||
| 1450 | if (__free_hook != emacs_blocked_free) | ||
| 1451 | old_free_hook = __free_hook; | ||
| 1452 | __free_hook = emacs_blocked_free; | ||
| 1453 | |||
| 1454 | if (__malloc_hook != emacs_blocked_malloc) | ||
| 1455 | old_malloc_hook = __malloc_hook; | ||
| 1456 | __malloc_hook = emacs_blocked_malloc; | ||
| 1457 | |||
| 1458 | if (__realloc_hook != emacs_blocked_realloc) | ||
| 1459 | old_realloc_hook = __realloc_hook; | ||
| 1460 | __realloc_hook = emacs_blocked_realloc; | ||
| 1461 | } | ||
| 1462 | |||
| 1463 | #endif /* not SYNC_INPUT */ | ||
| 1464 | #endif /* not SYSTEM_MALLOC */ | ||
| 1465 | |||
| 1466 | |||
| 1467 | |||
| 1468 | /*********************************************************************** | 1137 | /*********************************************************************** |
| 1469 | Interval Allocation | 1138 | Interval Allocation |
| 1470 | ***********************************************************************/ | 1139 | ***********************************************************************/ |
| @@ -1475,7 +1144,7 @@ uninterrupt_malloc (void) | |||
| 1475 | #define INTERVAL_BLOCK_SIZE \ | 1144 | #define INTERVAL_BLOCK_SIZE \ |
| 1476 | ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) | 1145 | ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) |
| 1477 | 1146 | ||
| 1478 | /* Intervals are allocated in chunks in form of an interval_block | 1147 | /* Intervals are allocated in chunks in the form of an interval_block |
| 1479 | structure. */ | 1148 | structure. */ |
| 1480 | 1149 | ||
| 1481 | struct interval_block | 1150 | struct interval_block |
| @@ -1510,8 +1179,6 @@ make_interval (void) | |||
| 1510 | { | 1179 | { |
| 1511 | INTERVAL val; | 1180 | INTERVAL val; |
| 1512 | 1181 | ||
| 1513 | /* eassert (!handling_signal); */ | ||
| 1514 | |||
| 1515 | MALLOC_BLOCK_INPUT; | 1182 | MALLOC_BLOCK_INPUT; |
| 1516 | 1183 | ||
| 1517 | if (interval_free_list) | 1184 | if (interval_free_list) |
| @@ -1895,8 +1562,6 @@ allocate_string (void) | |||
| 1895 | { | 1562 | { |
| 1896 | struct Lisp_String *s; | 1563 | struct Lisp_String *s; |
| 1897 | 1564 | ||
| 1898 | /* eassert (!handling_signal); */ | ||
| 1899 | |||
| 1900 | MALLOC_BLOCK_INPUT; | 1565 | MALLOC_BLOCK_INPUT; |
| 1901 | 1566 | ||
| 1902 | /* If the free-list is empty, allocate a new string_block, and | 1567 | /* If the free-list is empty, allocate a new string_block, and |
| @@ -2001,7 +1666,7 @@ allocate_string_data (struct Lisp_String *s, | |||
| 2001 | b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); | 1666 | b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); |
| 2002 | 1667 | ||
| 2003 | #ifdef DOUG_LEA_MALLOC | 1668 | #ifdef DOUG_LEA_MALLOC |
| 2004 | /* Back to a reasonable maximum of mmap'ed areas. */ | 1669 | /* Back to a reasonable maximum of mmap'ed areas. */ |
| 2005 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); | 1670 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
| 2006 | #endif | 1671 | #endif |
| 2007 | 1672 | ||
| @@ -2218,7 +1883,7 @@ compact_small_strings (void) | |||
| 2218 | 1883 | ||
| 2219 | #ifdef GC_CHECK_STRING_BYTES | 1884 | #ifdef GC_CHECK_STRING_BYTES |
| 2220 | /* Check that the string size recorded in the string is the | 1885 | /* Check that the string size recorded in the string is the |
| 2221 | same as the one recorded in the sdata structure. */ | 1886 | same as the one recorded in the sdata structure. */ |
| 2222 | if (s && string_bytes (s) != SDATA_NBYTES (from)) | 1887 | if (s && string_bytes (s) != SDATA_NBYTES (from)) |
| 2223 | emacs_abort (); | 1888 | emacs_abort (); |
| 2224 | #endif /* GC_CHECK_STRING_BYTES */ | 1889 | #endif /* GC_CHECK_STRING_BYTES */ |
| @@ -2353,7 +2018,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) | |||
| 2353 | val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil); | 2018 | val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil); |
| 2354 | 2019 | ||
| 2355 | /* No Lisp_Object to trace in there. */ | 2020 | /* No Lisp_Object to trace in there. */ |
| 2356 | XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0); | 2021 | XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0); |
| 2357 | 2022 | ||
| 2358 | p = XBOOL_VECTOR (val); | 2023 | p = XBOOL_VECTOR (val); |
| 2359 | p->size = XFASTINT (length); | 2024 | p->size = XFASTINT (length); |
| @@ -2588,8 +2253,6 @@ make_float (double float_value) | |||
| 2588 | { | 2253 | { |
| 2589 | register Lisp_Object val; | 2254 | register Lisp_Object val; |
| 2590 | 2255 | ||
| 2591 | /* eassert (!handling_signal); */ | ||
| 2592 | |||
| 2593 | MALLOC_BLOCK_INPUT; | 2256 | MALLOC_BLOCK_INPUT; |
| 2594 | 2257 | ||
| 2595 | if (float_free_list) | 2258 | if (float_free_list) |
| @@ -2697,8 +2360,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, | |||
| 2697 | { | 2360 | { |
| 2698 | register Lisp_Object val; | 2361 | register Lisp_Object val; |
| 2699 | 2362 | ||
| 2700 | /* eassert (!handling_signal); */ | ||
| 2701 | |||
| 2702 | MALLOC_BLOCK_INPUT; | 2363 | MALLOC_BLOCK_INPUT; |
| 2703 | 2364 | ||
| 2704 | if (cons_free_list) | 2365 | if (cons_free_list) |
| @@ -2936,19 +2597,54 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS)); | |||
| 2936 | 2597 | ||
| 2937 | #define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size) | 2598 | #define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size) |
| 2938 | 2599 | ||
| 2600 | /* Get and set the next field in block-allocated vectorlike objects on | ||
| 2601 | the free list. Doing it this way respects C's aliasing rules. | ||
| 2602 | We could instead make 'contents' a union, but that would mean | ||
| 2603 | changes everywhere that the code uses 'contents'. */ | ||
| 2604 | static struct Lisp_Vector * | ||
| 2605 | next_in_free_list (struct Lisp_Vector *v) | ||
| 2606 | { | ||
| 2607 | intptr_t i = XLI (v->contents[0]); | ||
| 2608 | return (struct Lisp_Vector *) i; | ||
| 2609 | } | ||
| 2610 | static void | ||
| 2611 | set_next_in_free_list (struct Lisp_Vector *v, struct Lisp_Vector *next) | ||
| 2612 | { | ||
| 2613 | v->contents[0] = XIL ((intptr_t) next); | ||
| 2614 | } | ||
| 2615 | |||
| 2939 | /* Common shortcut to setup vector on a free list. */ | 2616 | /* Common shortcut to setup vector on a free list. */ |
| 2940 | 2617 | ||
| 2941 | #define SETUP_ON_FREE_LIST(v, nbytes, index) \ | 2618 | #define SETUP_ON_FREE_LIST(v, nbytes, tmp) \ |
| 2942 | do { \ | 2619 | do { \ |
| 2943 | XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \ | 2620 | (tmp) = ((nbytes - header_size) / word_size); \ |
| 2944 | eassert ((nbytes) % roundup_size == 0); \ | 2621 | XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \ |
| 2945 | (index) = VINDEX (nbytes); \ | 2622 | eassert ((nbytes) % roundup_size == 0); \ |
| 2946 | eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ | 2623 | (tmp) = VINDEX (nbytes); \ |
| 2947 | (v)->header.next.vector = vector_free_lists[index]; \ | 2624 | eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \ |
| 2948 | vector_free_lists[index] = (v); \ | 2625 | set_next_in_free_list (v, vector_free_lists[tmp]); \ |
| 2949 | total_free_vector_slots += (nbytes) / word_size; \ | 2626 | vector_free_lists[tmp] = (v); \ |
| 2627 | total_free_vector_slots += (nbytes) / word_size; \ | ||
| 2950 | } while (0) | 2628 | } while (0) |
| 2951 | 2629 | ||
| 2630 | /* This internal type is used to maintain the list of large vectors | ||
| 2631 | which are allocated at their own, e.g. outside of vector blocks. */ | ||
| 2632 | |||
| 2633 | struct large_vector | ||
| 2634 | { | ||
| 2635 | union { | ||
| 2636 | struct large_vector *vector; | ||
| 2637 | #if USE_LSB_TAG | ||
| 2638 | /* We need to maintain ROUNDUP_SIZE alignment for the vector member. */ | ||
| 2639 | unsigned char c[vroundup (sizeof (struct large_vector *))]; | ||
| 2640 | #endif | ||
| 2641 | } next; | ||
| 2642 | struct Lisp_Vector v; | ||
| 2643 | }; | ||
| 2644 | |||
| 2645 | /* This internal type is used to maintain an underlying storage | ||
| 2646 | for small vectors. */ | ||
| 2647 | |||
| 2952 | struct vector_block | 2648 | struct vector_block |
| 2953 | { | 2649 | { |
| 2954 | char data[VECTOR_BLOCK_BYTES]; | 2650 | char data[VECTOR_BLOCK_BYTES]; |
| @@ -2966,7 +2662,7 @@ static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX]; | |||
| 2966 | 2662 | ||
| 2967 | /* Singly-linked list of large vectors. */ | 2663 | /* Singly-linked list of large vectors. */ |
| 2968 | 2664 | ||
| 2969 | static struct Lisp_Vector *large_vectors; | 2665 | static struct large_vector *large_vectors; |
| 2970 | 2666 | ||
| 2971 | /* The only vector with 0 slots, allocated from pure space. */ | 2667 | /* The only vector with 0 slots, allocated from pure space. */ |
| 2972 | 2668 | ||
| @@ -3010,7 +2706,7 @@ init_vectors (void) | |||
| 3010 | static struct Lisp_Vector * | 2706 | static struct Lisp_Vector * |
| 3011 | allocate_vector_from_block (size_t nbytes) | 2707 | allocate_vector_from_block (size_t nbytes) |
| 3012 | { | 2708 | { |
| 3013 | struct Lisp_Vector *vector, *rest; | 2709 | struct Lisp_Vector *vector; |
| 3014 | struct vector_block *block; | 2710 | struct vector_block *block; |
| 3015 | size_t index, restbytes; | 2711 | size_t index, restbytes; |
| 3016 | 2712 | ||
| @@ -3023,8 +2719,7 @@ allocate_vector_from_block (size_t nbytes) | |||
| 3023 | if (vector_free_lists[index]) | 2719 | if (vector_free_lists[index]) |
| 3024 | { | 2720 | { |
| 3025 | vector = vector_free_lists[index]; | 2721 | vector = vector_free_lists[index]; |
| 3026 | vector_free_lists[index] = vector->header.next.vector; | 2722 | vector_free_lists[index] = next_in_free_list (vector); |
| 3027 | vector->header.next.nbytes = nbytes; | ||
| 3028 | total_free_vector_slots -= nbytes / word_size; | 2723 | total_free_vector_slots -= nbytes / word_size; |
| 3029 | return vector; | 2724 | return vector; |
| 3030 | } | 2725 | } |
| @@ -3038,16 +2733,14 @@ allocate_vector_from_block (size_t nbytes) | |||
| 3038 | { | 2733 | { |
| 3039 | /* This vector is larger than requested. */ | 2734 | /* This vector is larger than requested. */ |
| 3040 | vector = vector_free_lists[index]; | 2735 | vector = vector_free_lists[index]; |
| 3041 | vector_free_lists[index] = vector->header.next.vector; | 2736 | vector_free_lists[index] = next_in_free_list (vector); |
| 3042 | vector->header.next.nbytes = nbytes; | ||
| 3043 | total_free_vector_slots -= nbytes / word_size; | 2737 | total_free_vector_slots -= nbytes / word_size; |
| 3044 | 2738 | ||
| 3045 | /* Excess bytes are used for the smaller vector, | 2739 | /* Excess bytes are used for the smaller vector, |
| 3046 | which should be set on an appropriate free list. */ | 2740 | which should be set on an appropriate free list. */ |
| 3047 | restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; | 2741 | restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; |
| 3048 | eassert (restbytes % roundup_size == 0); | 2742 | eassert (restbytes % roundup_size == 0); |
| 3049 | rest = ADVANCE (vector, nbytes); | 2743 | SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); |
| 3050 | SETUP_ON_FREE_LIST (rest, restbytes, index); | ||
| 3051 | return vector; | 2744 | return vector; |
| 3052 | } | 2745 | } |
| 3053 | 2746 | ||
| @@ -3056,7 +2749,6 @@ allocate_vector_from_block (size_t nbytes) | |||
| 3056 | 2749 | ||
| 3057 | /* New vector will be at the beginning of this block. */ | 2750 | /* New vector will be at the beginning of this block. */ |
| 3058 | vector = (struct Lisp_Vector *) block->data; | 2751 | vector = (struct Lisp_Vector *) block->data; |
| 3059 | vector->header.next.nbytes = nbytes; | ||
| 3060 | 2752 | ||
| 3061 | /* If the rest of space from this block is large enough | 2753 | /* If the rest of space from this block is large enough |
| 3062 | for one-slot vector at least, set up it on a free list. */ | 2754 | for one-slot vector at least, set up it on a free list. */ |
| @@ -3064,11 +2756,10 @@ allocate_vector_from_block (size_t nbytes) | |||
| 3064 | if (restbytes >= VBLOCK_BYTES_MIN) | 2756 | if (restbytes >= VBLOCK_BYTES_MIN) |
| 3065 | { | 2757 | { |
| 3066 | eassert (restbytes % roundup_size == 0); | 2758 | eassert (restbytes % roundup_size == 0); |
| 3067 | rest = ADVANCE (vector, nbytes); | 2759 | SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); |
| 3068 | SETUP_ON_FREE_LIST (rest, restbytes, index); | ||
| 3069 | } | 2760 | } |
| 3070 | return vector; | 2761 | return vector; |
| 3071 | } | 2762 | } |
| 3072 | 2763 | ||
| 3073 | /* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */ | 2764 | /* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */ |
| 3074 | 2765 | ||
| @@ -3076,15 +2767,30 @@ allocate_vector_from_block (size_t nbytes) | |||
| 3076 | ((char *) (vector) <= (block)->data \ | 2767 | ((char *) (vector) <= (block)->data \ |
| 3077 | + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) | 2768 | + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) |
| 3078 | 2769 | ||
| 3079 | /* Number of bytes used by vector-block-allocated object. This is the only | 2770 | /* Return the memory footprint of V in bytes. */ |
| 3080 | place where we actually use the `nbytes' field of the vector-header. | ||
| 3081 | I.e. we could get rid of the `nbytes' field by computing it based on the | ||
| 3082 | vector-type. */ | ||
| 3083 | 2771 | ||
| 3084 | #define PSEUDOVECTOR_NBYTES(vector) \ | 2772 | static ptrdiff_t |
| 3085 | (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \ | 2773 | vector_nbytes (struct Lisp_Vector *v) |
| 3086 | ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \ | 2774 | { |
| 3087 | : vector->header.next.nbytes) | 2775 | ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG; |
| 2776 | |||
| 2777 | if (size & PSEUDOVECTOR_FLAG) | ||
| 2778 | { | ||
| 2779 | if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR)) | ||
| 2780 | size = (bool_header_size | ||
| 2781 | + (((struct Lisp_Bool_Vector *) v)->size | ||
| 2782 | + BOOL_VECTOR_BITS_PER_CHAR - 1) | ||
| 2783 | / BOOL_VECTOR_BITS_PER_CHAR); | ||
| 2784 | else | ||
| 2785 | size = (header_size | ||
| 2786 | + ((size & PSEUDOVECTOR_SIZE_MASK) | ||
| 2787 | + ((size & PSEUDOVECTOR_REST_MASK) | ||
| 2788 | >> PSEUDOVECTOR_SIZE_BITS)) * word_size); | ||
| 2789 | } | ||
| 2790 | else | ||
| 2791 | size = header_size + size * word_size; | ||
| 2792 | return vroundup (size); | ||
| 2793 | } | ||
| 3088 | 2794 | ||
| 3089 | /* Reclaim space used by unmarked vectors. */ | 2795 | /* Reclaim space used by unmarked vectors. */ |
| 3090 | 2796 | ||
| @@ -3092,7 +2798,8 @@ static void | |||
| 3092 | sweep_vectors (void) | 2798 | sweep_vectors (void) |
| 3093 | { | 2799 | { |
| 3094 | struct vector_block *block = vector_blocks, **bprev = &vector_blocks; | 2800 | struct vector_block *block = vector_blocks, **bprev = &vector_blocks; |
| 3095 | struct Lisp_Vector *vector, *next, **vprev = &large_vectors; | 2801 | struct large_vector *lv, **lvprev = &large_vectors; |
| 2802 | struct Lisp_Vector *vector, *next; | ||
| 3096 | 2803 | ||
| 3097 | total_vectors = total_vector_slots = total_free_vector_slots = 0; | 2804 | total_vectors = total_vector_slots = total_free_vector_slots = 0; |
| 3098 | memset (vector_free_lists, 0, sizeof (vector_free_lists)); | 2805 | memset (vector_free_lists, 0, sizeof (vector_free_lists)); |
| @@ -3102,6 +2809,7 @@ sweep_vectors (void) | |||
| 3102 | for (block = vector_blocks; block; block = *bprev) | 2809 | for (block = vector_blocks; block; block = *bprev) |
| 3103 | { | 2810 | { |
| 3104 | bool free_this_block = 0; | 2811 | bool free_this_block = 0; |
| 2812 | ptrdiff_t nbytes; | ||
| 3105 | 2813 | ||
| 3106 | for (vector = (struct Lisp_Vector *) block->data; | 2814 | for (vector = (struct Lisp_Vector *) block->data; |
| 3107 | VECTOR_IN_BLOCK (vector, block); vector = next) | 2815 | VECTOR_IN_BLOCK (vector, block); vector = next) |
| @@ -3110,14 +2818,16 @@ sweep_vectors (void) | |||
| 3110 | { | 2818 | { |
| 3111 | VECTOR_UNMARK (vector); | 2819 | VECTOR_UNMARK (vector); |
| 3112 | total_vectors++; | 2820 | total_vectors++; |
| 3113 | total_vector_slots += vector->header.next.nbytes / word_size; | 2821 | nbytes = vector_nbytes (vector); |
| 3114 | next = ADVANCE (vector, vector->header.next.nbytes); | 2822 | total_vector_slots += nbytes / word_size; |
| 2823 | next = ADVANCE (vector, nbytes); | ||
| 3115 | } | 2824 | } |
| 3116 | else | 2825 | else |
| 3117 | { | 2826 | { |
| 3118 | ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); | 2827 | ptrdiff_t total_bytes; |
| 3119 | ptrdiff_t total_bytes = nbytes; | ||
| 3120 | 2828 | ||
| 2829 | nbytes = vector_nbytes (vector); | ||
| 2830 | total_bytes = nbytes; | ||
| 3121 | next = ADVANCE (vector, nbytes); | 2831 | next = ADVANCE (vector, nbytes); |
| 3122 | 2832 | ||
| 3123 | /* While NEXT is not marked, try to coalesce with VECTOR, | 2833 | /* While NEXT is not marked, try to coalesce with VECTOR, |
| @@ -3127,7 +2837,7 @@ sweep_vectors (void) | |||
| 3127 | { | 2837 | { |
| 3128 | if (VECTOR_MARKED_P (next)) | 2838 | if (VECTOR_MARKED_P (next)) |
| 3129 | break; | 2839 | break; |
| 3130 | nbytes = PSEUDOVECTOR_NBYTES (next); | 2840 | nbytes = vector_nbytes (next); |
| 3131 | total_bytes += nbytes; | 2841 | total_bytes += nbytes; |
| 3132 | next = ADVANCE (next, nbytes); | 2842 | next = ADVANCE (next, nbytes); |
| 3133 | } | 2843 | } |
| @@ -3161,8 +2871,9 @@ sweep_vectors (void) | |||
| 3161 | 2871 | ||
| 3162 | /* Sweep large vectors. */ | 2872 | /* Sweep large vectors. */ |
| 3163 | 2873 | ||
| 3164 | for (vector = large_vectors; vector; vector = *vprev) | 2874 | for (lv = large_vectors; lv; lv = *lvprev) |
| 3165 | { | 2875 | { |
| 2876 | vector = &lv->v; | ||
| 3166 | if (VECTOR_MARKED_P (vector)) | 2877 | if (VECTOR_MARKED_P (vector)) |
| 3167 | { | 2878 | { |
| 3168 | VECTOR_UNMARK (vector); | 2879 | VECTOR_UNMARK (vector); |
| @@ -3184,12 +2895,12 @@ sweep_vectors (void) | |||
| 3184 | else | 2895 | else |
| 3185 | total_vector_slots | 2896 | total_vector_slots |
| 3186 | += header_size / word_size + vector->header.size; | 2897 | += header_size / word_size + vector->header.size; |
| 3187 | vprev = &vector->header.next.vector; | 2898 | lvprev = &lv->next.vector; |
| 3188 | } | 2899 | } |
| 3189 | else | 2900 | else |
| 3190 | { | 2901 | { |
| 3191 | *vprev = vector->header.next.vector; | 2902 | *lvprev = lv->next.vector; |
| 3192 | lisp_free (vector); | 2903 | lisp_free (lv); |
| 3193 | } | 2904 | } |
| 3194 | } | 2905 | } |
| 3195 | } | 2906 | } |
| @@ -3204,9 +2915,6 @@ allocate_vectorlike (ptrdiff_t len) | |||
| 3204 | 2915 | ||
| 3205 | MALLOC_BLOCK_INPUT; | 2916 | MALLOC_BLOCK_INPUT; |
| 3206 | 2917 | ||
| 3207 | /* This gets triggered by code which I haven't bothered to fix. --Stef */ | ||
| 3208 | /* eassert (!handling_signal); */ | ||
| 3209 | |||
| 3210 | if (len == 0) | 2918 | if (len == 0) |
| 3211 | p = XVECTOR (zero_vector); | 2919 | p = XVECTOR (zero_vector); |
| 3212 | else | 2920 | else |
| @@ -3224,9 +2932,12 @@ allocate_vectorlike (ptrdiff_t len) | |||
| 3224 | p = allocate_vector_from_block (vroundup (nbytes)); | 2932 | p = allocate_vector_from_block (vroundup (nbytes)); |
| 3225 | else | 2933 | else |
| 3226 | { | 2934 | { |
| 3227 | p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); | 2935 | struct large_vector *lv |
| 3228 | p->header.next.vector = large_vectors; | 2936 | = lisp_malloc (sizeof (*lv) + (len - 1) * word_size, |
| 3229 | large_vectors = p; | 2937 | MEM_TYPE_VECTORLIKE); |
| 2938 | lv->next.vector = large_vectors; | ||
| 2939 | large_vectors = lv; | ||
| 2940 | p = &lv->v; | ||
| 3230 | } | 2941 | } |
| 3231 | 2942 | ||
| 3232 | #ifdef DOUG_LEA_MALLOC | 2943 | #ifdef DOUG_LEA_MALLOC |
| @@ -3263,16 +2974,21 @@ allocate_vector (EMACS_INT len) | |||
| 3263 | /* Allocate other vector-like structures. */ | 2974 | /* Allocate other vector-like structures. */ |
| 3264 | 2975 | ||
| 3265 | struct Lisp_Vector * | 2976 | struct Lisp_Vector * |
| 3266 | allocate_pseudovector (int memlen, int lisplen, int tag) | 2977 | allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag) |
| 3267 | { | 2978 | { |
| 3268 | struct Lisp_Vector *v = allocate_vectorlike (memlen); | 2979 | struct Lisp_Vector *v = allocate_vectorlike (memlen); |
| 3269 | int i; | 2980 | int i; |
| 3270 | 2981 | ||
| 2982 | /* Catch bogus values. */ | ||
| 2983 | eassert (tag <= PVEC_FONT); | ||
| 2984 | eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1); | ||
| 2985 | eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1); | ||
| 2986 | |||
| 3271 | /* Only the first lisplen slots will be traced normally by the GC. */ | 2987 | /* Only the first lisplen slots will be traced normally by the GC. */ |
| 3272 | for (i = 0; i < lisplen; ++i) | 2988 | for (i = 0; i < lisplen; ++i) |
| 3273 | v->contents[i] = Qnil; | 2989 | v->contents[i] = Qnil; |
| 3274 | 2990 | ||
| 3275 | XSETPVECTYPESIZE (v, tag, lisplen); | 2991 | XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen); |
| 3276 | return v; | 2992 | return v; |
| 3277 | } | 2993 | } |
| 3278 | 2994 | ||
| @@ -3281,10 +2997,9 @@ allocate_buffer (void) | |||
| 3281 | { | 2997 | { |
| 3282 | struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); | 2998 | struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); |
| 3283 | 2999 | ||
| 3284 | XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text) | 3000 | BUFFER_PVEC_INIT (b); |
| 3285 | - header_size) / word_size); | ||
| 3286 | /* Put B on the chain of all buffers including killed ones. */ | 3001 | /* Put B on the chain of all buffers including killed ones. */ |
| 3287 | b->header.next.buffer = all_buffers; | 3002 | b->next = all_buffers; |
| 3288 | all_buffers = b; | 3003 | all_buffers = b; |
| 3289 | /* Note that the rest fields of B are not initialized. */ | 3004 | /* Note that the rest fields of B are not initialized. */ |
| 3290 | return b; | 3005 | return b; |
| @@ -3372,13 +3087,10 @@ Any number of arguments, even zero arguments, are allowed. | |||
| 3372 | usage: (vector &rest OBJECTS) */) | 3087 | usage: (vector &rest OBJECTS) */) |
| 3373 | (ptrdiff_t nargs, Lisp_Object *args) | 3088 | (ptrdiff_t nargs, Lisp_Object *args) |
| 3374 | { | 3089 | { |
| 3375 | register Lisp_Object len, val; | ||
| 3376 | ptrdiff_t i; | 3090 | ptrdiff_t i; |
| 3377 | register struct Lisp_Vector *p; | 3091 | register Lisp_Object val = make_uninit_vector (nargs); |
| 3092 | register struct Lisp_Vector *p = XVECTOR (val); | ||
| 3378 | 3093 | ||
| 3379 | XSETFASTINT (len, nargs); | ||
| 3380 | val = Fmake_vector (len, Qnil); | ||
| 3381 | p = XVECTOR (val); | ||
| 3382 | for (i = 0; i < nargs; i++) | 3094 | for (i = 0; i < nargs; i++) |
| 3383 | p->contents[i] = args[i]; | 3095 | p->contents[i] = args[i]; |
| 3384 | return val; | 3096 | return val; |
| @@ -3416,11 +3128,11 @@ stack before executing the byte-code. | |||
| 3416 | usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) | 3128 | usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) |
| 3417 | (ptrdiff_t nargs, Lisp_Object *args) | 3129 | (ptrdiff_t nargs, Lisp_Object *args) |
| 3418 | { | 3130 | { |
| 3419 | register Lisp_Object len, val; | ||
| 3420 | ptrdiff_t i; | 3131 | ptrdiff_t i; |
| 3421 | register struct Lisp_Vector *p; | 3132 | register Lisp_Object val = make_uninit_vector (nargs); |
| 3133 | register struct Lisp_Vector *p = XVECTOR (val); | ||
| 3422 | 3134 | ||
| 3423 | /* We used to purecopy everything here, if purify-flga was set. This worked | 3135 | /* We used to purecopy everything here, if purify-flag was set. This worked |
| 3424 | OK for Emacs-23, but with Emacs-24's lexical binding code, it can be | 3136 | OK for Emacs-23, but with Emacs-24's lexical binding code, it can be |
| 3425 | dangerous, since make-byte-code is used during execution to build | 3137 | dangerous, since make-byte-code is used during execution to build |
| 3426 | closures, so any closure built during the preload phase would end up | 3138 | closures, so any closure built during the preload phase would end up |
| @@ -3428,10 +3140,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT | |||
| 3428 | just wasteful and other times plainly wrong (e.g. those free vars may want | 3140 | just wasteful and other times plainly wrong (e.g. those free vars may want |
| 3429 | to be setcar'd). */ | 3141 | to be setcar'd). */ |
| 3430 | 3142 | ||
| 3431 | XSETFASTINT (len, nargs); | ||
| 3432 | val = Fmake_vector (len, Qnil); | ||
| 3433 | |||
| 3434 | p = XVECTOR (val); | ||
| 3435 | for (i = 0; i < nargs; i++) | 3143 | for (i = 0; i < nargs; i++) |
| 3436 | p->contents[i] = args[i]; | 3144 | p->contents[i] = args[i]; |
| 3437 | make_byte_code (p); | 3145 | make_byte_code (p); |
| @@ -3483,7 +3191,7 @@ static struct Lisp_Symbol *symbol_free_list; | |||
| 3483 | 3191 | ||
| 3484 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, | 3192 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, |
| 3485 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. | 3193 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. |
| 3486 | Its value and function definition are void, and its property list is nil. */) | 3194 | Its value is void, and its function definition and property list are nil. */) |
| 3487 | (Lisp_Object name) | 3195 | (Lisp_Object name) |
| 3488 | { | 3196 | { |
| 3489 | register Lisp_Object val; | 3197 | register Lisp_Object val; |
| @@ -3491,8 +3199,6 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3491 | 3199 | ||
| 3492 | CHECK_STRING (name); | 3200 | CHECK_STRING (name); |
| 3493 | 3201 | ||
| 3494 | /* eassert (!handling_signal); */ | ||
| 3495 | |||
| 3496 | MALLOC_BLOCK_INPUT; | 3202 | MALLOC_BLOCK_INPUT; |
| 3497 | 3203 | ||
| 3498 | if (symbol_free_list) | 3204 | if (symbol_free_list) |
| @@ -3522,7 +3228,7 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3522 | set_symbol_plist (val, Qnil); | 3228 | set_symbol_plist (val, Qnil); |
| 3523 | p->redirect = SYMBOL_PLAINVAL; | 3229 | p->redirect = SYMBOL_PLAINVAL; |
| 3524 | SET_SYMBOL_VAL (p, Qunbound); | 3230 | SET_SYMBOL_VAL (p, Qunbound); |
| 3525 | set_symbol_function (val, Qunbound); | 3231 | set_symbol_function (val, Qnil); |
| 3526 | set_symbol_next (val, NULL); | 3232 | set_symbol_next (val, NULL); |
| 3527 | p->gcmarkbit = 0; | 3233 | p->gcmarkbit = 0; |
| 3528 | p->interned = SYMBOL_UNINTERNED; | 3234 | p->interned = SYMBOL_UNINTERNED; |
| @@ -3577,8 +3283,6 @@ allocate_misc (enum Lisp_Misc_Type type) | |||
| 3577 | { | 3283 | { |
| 3578 | Lisp_Object val; | 3284 | Lisp_Object val; |
| 3579 | 3285 | ||
| 3580 | /* eassert (!handling_signal); */ | ||
| 3581 | |||
| 3582 | MALLOC_BLOCK_INPUT; | 3286 | MALLOC_BLOCK_INPUT; |
| 3583 | 3287 | ||
| 3584 | if (marker_free_list) | 3288 | if (marker_free_list) |
| @@ -3610,9 +3314,9 @@ allocate_misc (enum Lisp_Misc_Type type) | |||
| 3610 | return val; | 3314 | return val; |
| 3611 | } | 3315 | } |
| 3612 | 3316 | ||
| 3613 | /* Free a Lisp_Misc object */ | 3317 | /* Free a Lisp_Misc object. */ |
| 3614 | 3318 | ||
| 3615 | static void | 3319 | void |
| 3616 | free_misc (Lisp_Object misc) | 3320 | free_misc (Lisp_Object misc) |
| 3617 | { | 3321 | { |
| 3618 | XMISCTYPE (misc) = Lisp_Misc_Free; | 3322 | XMISCTYPE (misc) = Lisp_Misc_Free; |
| @@ -3622,24 +3326,75 @@ free_misc (Lisp_Object misc) | |||
| 3622 | total_free_markers++; | 3326 | total_free_markers++; |
| 3623 | } | 3327 | } |
| 3624 | 3328 | ||
| 3625 | /* Return a Lisp_Misc_Save_Value object containing POINTER and | 3329 | /* Verify properties of Lisp_Save_Value's representation |
| 3626 | INTEGER. This is used to package C values to call record_unwind_protect. | 3330 | that are assumed here and elsewhere. */ |
| 3627 | The unwind function can get the C values back using XSAVE_VALUE. */ | 3331 | |
| 3332 | verify (SAVE_UNUSED == 0); | ||
| 3333 | verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0); | ||
| 3334 | |||
| 3335 | /* Return a Lisp_Save_Value object with the data saved according to | ||
| 3336 | DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ | ||
| 3628 | 3337 | ||
| 3629 | Lisp_Object | 3338 | Lisp_Object |
| 3630 | make_save_value (void *pointer, ptrdiff_t integer) | 3339 | make_save_value (enum Lisp_Save_Type save_type, ...) |
| 3631 | { | 3340 | { |
| 3632 | register Lisp_Object val; | 3341 | va_list ap; |
| 3633 | register struct Lisp_Save_Value *p; | 3342 | int i; |
| 3343 | Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); | ||
| 3344 | struct Lisp_Save_Value *p = XSAVE_VALUE (val); | ||
| 3345 | |||
| 3346 | eassert (0 < save_type | ||
| 3347 | && (save_type < 1 << (SAVE_TYPE_BITS - 1) | ||
| 3348 | || save_type == SAVE_TYPE_MEMORY)); | ||
| 3349 | p->save_type = save_type; | ||
| 3350 | va_start (ap, save_type); | ||
| 3351 | save_type &= ~ (1 << (SAVE_TYPE_BITS - 1)); | ||
| 3352 | |||
| 3353 | for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS) | ||
| 3354 | switch (save_type & ((1 << SAVE_SLOT_BITS) - 1)) | ||
| 3355 | { | ||
| 3356 | case SAVE_POINTER: | ||
| 3357 | p->data[i].pointer = va_arg (ap, void *); | ||
| 3358 | break; | ||
| 3359 | |||
| 3360 | case SAVE_INTEGER: | ||
| 3361 | p->data[i].integer = va_arg (ap, ptrdiff_t); | ||
| 3362 | break; | ||
| 3363 | |||
| 3364 | case SAVE_OBJECT: | ||
| 3365 | p->data[i].object = va_arg (ap, Lisp_Object); | ||
| 3366 | break; | ||
| 3634 | 3367 | ||
| 3635 | val = allocate_misc (Lisp_Misc_Save_Value); | 3368 | default: |
| 3636 | p = XSAVE_VALUE (val); | 3369 | emacs_abort (); |
| 3637 | p->pointer = pointer; | 3370 | } |
| 3638 | p->integer = integer; | 3371 | |
| 3639 | p->dogc = 0; | 3372 | va_end (ap); |
| 3640 | return val; | 3373 | return val; |
| 3641 | } | 3374 | } |
| 3642 | 3375 | ||
| 3376 | /* The most common task it to save just one C pointer. */ | ||
| 3377 | |||
| 3378 | Lisp_Object | ||
| 3379 | make_save_pointer (void *pointer) | ||
| 3380 | { | ||
| 3381 | Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); | ||
| 3382 | struct Lisp_Save_Value *p = XSAVE_VALUE (val); | ||
| 3383 | p->save_type = SAVE_POINTER; | ||
| 3384 | p->data[0].pointer = pointer; | ||
| 3385 | return val; | ||
| 3386 | } | ||
| 3387 | |||
| 3388 | /* Free a Lisp_Save_Value object. Do not use this function | ||
| 3389 | if SAVE contains pointer other than returned by xmalloc. */ | ||
| 3390 | |||
| 3391 | static void | ||
| 3392 | free_save_value (Lisp_Object save) | ||
| 3393 | { | ||
| 3394 | xfree (XSAVE_POINTER (save, 0)); | ||
| 3395 | free_misc (save); | ||
| 3396 | } | ||
| 3397 | |||
| 3643 | /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ | 3398 | /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ |
| 3644 | 3399 | ||
| 3645 | Lisp_Object | 3400 | Lisp_Object |
| @@ -3798,12 +3553,6 @@ memory_full (size_t nbytes) | |||
| 3798 | lisp_free (spare_memory[i]); | 3553 | lisp_free (spare_memory[i]); |
| 3799 | spare_memory[i] = 0; | 3554 | spare_memory[i] = 0; |
| 3800 | } | 3555 | } |
| 3801 | |||
| 3802 | /* Record the space now used. When it decreases substantially, | ||
| 3803 | we can refill the memory reserve. */ | ||
| 3804 | #if !defined SYSTEM_MALLOC && !defined SYNC_INPUT | ||
| 3805 | bytes_used_when_full = BYTES_USED; | ||
| 3806 | #endif | ||
| 3807 | } | 3556 | } |
| 3808 | 3557 | ||
| 3809 | /* This used to call error, but if we've run out of memory, we could | 3558 | /* This used to call error, but if we've run out of memory, we could |
| @@ -3880,7 +3629,7 @@ mem_init (void) | |||
| 3880 | /* Value is a pointer to the mem_node containing START. Value is | 3629 | /* Value is a pointer to the mem_node containing START. Value is |
| 3881 | MEM_NIL if there is no node in the tree containing START. */ | 3630 | MEM_NIL if there is no node in the tree containing START. */ |
| 3882 | 3631 | ||
| 3883 | static inline struct mem_node * | 3632 | static struct mem_node * |
| 3884 | mem_find (void *start) | 3633 | mem_find (void *start) |
| 3885 | { | 3634 | { |
| 3886 | struct mem_node *p; | 3635 | struct mem_node *p; |
| @@ -3941,7 +3690,7 @@ mem_insert (void *start, void *end, enum mem_type type) | |||
| 3941 | 3690 | ||
| 3942 | /* Create a new node. */ | 3691 | /* Create a new node. */ |
| 3943 | #ifdef GC_MALLOC_CHECK | 3692 | #ifdef GC_MALLOC_CHECK |
| 3944 | x = _malloc_internal (sizeof *x); | 3693 | x = malloc (sizeof *x); |
| 3945 | if (x == NULL) | 3694 | if (x == NULL) |
| 3946 | emacs_abort (); | 3695 | emacs_abort (); |
| 3947 | #else | 3696 | #else |
| @@ -4165,7 +3914,7 @@ mem_delete (struct mem_node *z) | |||
| 4165 | mem_delete_fixup (x); | 3914 | mem_delete_fixup (x); |
| 4166 | 3915 | ||
| 4167 | #ifdef GC_MALLOC_CHECK | 3916 | #ifdef GC_MALLOC_CHECK |
| 4168 | _free_internal (y); | 3917 | free (y); |
| 4169 | #else | 3918 | #else |
| 4170 | xfree (y); | 3919 | xfree (y); |
| 4171 | #endif | 3920 | #endif |
| @@ -4256,7 +4005,7 @@ mem_delete_fixup (struct mem_node *x) | |||
| 4256 | /* Value is non-zero if P is a pointer to a live Lisp string on | 4005 | /* Value is non-zero if P is a pointer to a live Lisp string on |
| 4257 | the heap. M is a pointer to the mem_block for P. */ | 4006 | the heap. M is a pointer to the mem_block for P. */ |
| 4258 | 4007 | ||
| 4259 | static inline bool | 4008 | static bool |
| 4260 | live_string_p (struct mem_node *m, void *p) | 4009 | live_string_p (struct mem_node *m, void *p) |
| 4261 | { | 4010 | { |
| 4262 | if (m->type == MEM_TYPE_STRING) | 4011 | if (m->type == MEM_TYPE_STRING) |
| @@ -4279,7 +4028,7 @@ live_string_p (struct mem_node *m, void *p) | |||
| 4279 | /* Value is non-zero if P is a pointer to a live Lisp cons on | 4028 | /* Value is non-zero if P is a pointer to a live Lisp cons on |
| 4280 | the heap. M is a pointer to the mem_block for P. */ | 4029 | the heap. M is a pointer to the mem_block for P. */ |
| 4281 | 4030 | ||
| 4282 | static inline bool | 4031 | static bool |
| 4283 | live_cons_p (struct mem_node *m, void *p) | 4032 | live_cons_p (struct mem_node *m, void *p) |
| 4284 | { | 4033 | { |
| 4285 | if (m->type == MEM_TYPE_CONS) | 4034 | if (m->type == MEM_TYPE_CONS) |
| @@ -4305,7 +4054,7 @@ live_cons_p (struct mem_node *m, void *p) | |||
| 4305 | /* Value is non-zero if P is a pointer to a live Lisp symbol on | 4054 | /* Value is non-zero if P is a pointer to a live Lisp symbol on |
| 4306 | the heap. M is a pointer to the mem_block for P. */ | 4055 | the heap. M is a pointer to the mem_block for P. */ |
| 4307 | 4056 | ||
| 4308 | static inline bool | 4057 | static bool |
| 4309 | live_symbol_p (struct mem_node *m, void *p) | 4058 | live_symbol_p (struct mem_node *m, void *p) |
| 4310 | { | 4059 | { |
| 4311 | if (m->type == MEM_TYPE_SYMBOL) | 4060 | if (m->type == MEM_TYPE_SYMBOL) |
| @@ -4331,7 +4080,7 @@ live_symbol_p (struct mem_node *m, void *p) | |||
| 4331 | /* Value is non-zero if P is a pointer to a live Lisp float on | 4080 | /* Value is non-zero if P is a pointer to a live Lisp float on |
| 4332 | the heap. M is a pointer to the mem_block for P. */ | 4081 | the heap. M is a pointer to the mem_block for P. */ |
| 4333 | 4082 | ||
| 4334 | static inline bool | 4083 | static bool |
| 4335 | live_float_p (struct mem_node *m, void *p) | 4084 | live_float_p (struct mem_node *m, void *p) |
| 4336 | { | 4085 | { |
| 4337 | if (m->type == MEM_TYPE_FLOAT) | 4086 | if (m->type == MEM_TYPE_FLOAT) |
| @@ -4355,7 +4104,7 @@ live_float_p (struct mem_node *m, void *p) | |||
| 4355 | /* Value is non-zero if P is a pointer to a live Lisp Misc on | 4104 | /* Value is non-zero if P is a pointer to a live Lisp Misc on |
| 4356 | the heap. M is a pointer to the mem_block for P. */ | 4105 | the heap. M is a pointer to the mem_block for P. */ |
| 4357 | 4106 | ||
| 4358 | static inline bool | 4107 | static bool |
| 4359 | live_misc_p (struct mem_node *m, void *p) | 4108 | live_misc_p (struct mem_node *m, void *p) |
| 4360 | { | 4109 | { |
| 4361 | if (m->type == MEM_TYPE_MISC) | 4110 | if (m->type == MEM_TYPE_MISC) |
| @@ -4381,7 +4130,7 @@ live_misc_p (struct mem_node *m, void *p) | |||
| 4381 | /* Value is non-zero if P is a pointer to a live vector-like object. | 4130 | /* Value is non-zero if P is a pointer to a live vector-like object. |
| 4382 | M is a pointer to the mem_block for P. */ | 4131 | M is a pointer to the mem_block for P. */ |
| 4383 | 4132 | ||
| 4384 | static inline bool | 4133 | static bool |
| 4385 | live_vector_p (struct mem_node *m, void *p) | 4134 | live_vector_p (struct mem_node *m, void *p) |
| 4386 | { | 4135 | { |
| 4387 | if (m->type == MEM_TYPE_VECTOR_BLOCK) | 4136 | if (m->type == MEM_TYPE_VECTOR_BLOCK) |
| @@ -4398,16 +4147,15 @@ live_vector_p (struct mem_node *m, void *p) | |||
| 4398 | while (VECTOR_IN_BLOCK (vector, block) | 4147 | while (VECTOR_IN_BLOCK (vector, block) |
| 4399 | && vector <= (struct Lisp_Vector *) p) | 4148 | && vector <= (struct Lisp_Vector *) p) |
| 4400 | { | 4149 | { |
| 4401 | if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) | 4150 | if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p) |
| 4402 | vector = ADVANCE (vector, (vector->header.size | ||
| 4403 | & PSEUDOVECTOR_SIZE_MASK)); | ||
| 4404 | else if (vector == p) | ||
| 4405 | return 1; | 4151 | return 1; |
| 4406 | else | 4152 | else |
| 4407 | vector = ADVANCE (vector, vector->header.next.nbytes); | 4153 | vector = ADVANCE (vector, vector_nbytes (vector)); |
| 4408 | } | 4154 | } |
| 4409 | } | 4155 | } |
| 4410 | else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start) | 4156 | else if (m->type == MEM_TYPE_VECTORLIKE |
| 4157 | && (char *) p == ((char *) m->start | ||
| 4158 | + offsetof (struct large_vector, v))) | ||
| 4411 | /* This memory node corresponds to a large vector. */ | 4159 | /* This memory node corresponds to a large vector. */ |
| 4412 | return 1; | 4160 | return 1; |
| 4413 | return 0; | 4161 | return 0; |
| @@ -4417,7 +4165,7 @@ live_vector_p (struct mem_node *m, void *p) | |||
| 4417 | /* Value is non-zero if P is a pointer to a live buffer. M is a | 4165 | /* Value is non-zero if P is a pointer to a live buffer. M is a |
| 4418 | pointer to the mem_block for P. */ | 4166 | pointer to the mem_block for P. */ |
| 4419 | 4167 | ||
| 4420 | static inline bool | 4168 | static bool |
| 4421 | live_buffer_p (struct mem_node *m, void *p) | 4169 | live_buffer_p (struct mem_node *m, void *p) |
| 4422 | { | 4170 | { |
| 4423 | /* P must point to the start of the block, and the buffer | 4171 | /* P must point to the start of the block, and the buffer |
| @@ -4483,7 +4231,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", | |||
| 4483 | 4231 | ||
| 4484 | /* Mark OBJ if we can prove it's a Lisp_Object. */ | 4232 | /* Mark OBJ if we can prove it's a Lisp_Object. */ |
| 4485 | 4233 | ||
| 4486 | static inline void | 4234 | static void |
| 4487 | mark_maybe_object (Lisp_Object obj) | 4235 | mark_maybe_object (Lisp_Object obj) |
| 4488 | { | 4236 | { |
| 4489 | void *po; | 4237 | void *po; |
| @@ -4552,7 +4300,7 @@ mark_maybe_object (Lisp_Object obj) | |||
| 4552 | /* If P points to Lisp data, mark that as live if it isn't already | 4300 | /* If P points to Lisp data, mark that as live if it isn't already |
| 4553 | marked. */ | 4301 | marked. */ |
| 4554 | 4302 | ||
| 4555 | static inline void | 4303 | static void |
| 4556 | mark_maybe_pointer (void *p) | 4304 | mark_maybe_pointer (void *p) |
| 4557 | { | 4305 | { |
| 4558 | struct mem_node *m; | 4306 | struct mem_node *m; |
| @@ -4711,11 +4459,6 @@ mark_memory (void *start, void *end) | |||
| 4711 | } | 4459 | } |
| 4712 | } | 4460 | } |
| 4713 | 4461 | ||
| 4714 | /* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in | ||
| 4715 | the GCC system configuration. In gcc 3.2, the only systems for | ||
| 4716 | which this is so are i386-sco5 non-ELF, i386-sysv3 (maybe included | ||
| 4717 | by others?) and ns32k-pc532-min. */ | ||
| 4718 | |||
| 4719 | #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS | 4462 | #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS |
| 4720 | 4463 | ||
| 4721 | static bool setjmp_tested_p; | 4464 | static bool setjmp_tested_p; |
| @@ -4762,14 +4505,14 @@ test_setjmp (void) | |||
| 4762 | { | 4505 | { |
| 4763 | char buf[10]; | 4506 | char buf[10]; |
| 4764 | register int x; | 4507 | register int x; |
| 4765 | jmp_buf jbuf; | 4508 | sys_jmp_buf jbuf; |
| 4766 | 4509 | ||
| 4767 | /* Arrange for X to be put in a register. */ | 4510 | /* Arrange for X to be put in a register. */ |
| 4768 | sprintf (buf, "1"); | 4511 | sprintf (buf, "1"); |
| 4769 | x = strlen (buf); | 4512 | x = strlen (buf); |
| 4770 | x = 2 * x - 1; | 4513 | x = 2 * x - 1; |
| 4771 | 4514 | ||
| 4772 | _setjmp (jbuf); | 4515 | sys_setjmp (jbuf); |
| 4773 | if (longjmps_done == 1) | 4516 | if (longjmps_done == 1) |
| 4774 | { | 4517 | { |
| 4775 | /* Came here after the longjmp at the end of the function. | 4518 | /* Came here after the longjmp at the end of the function. |
| @@ -4794,7 +4537,7 @@ test_setjmp (void) | |||
| 4794 | ++longjmps_done; | 4537 | ++longjmps_done; |
| 4795 | x = 2; | 4538 | x = 2; |
| 4796 | if (longjmps_done == 1) | 4539 | if (longjmps_done == 1) |
| 4797 | _longjmp (jbuf, 1); | 4540 | sys_longjmp (jbuf, 1); |
| 4798 | } | 4541 | } |
| 4799 | 4542 | ||
| 4800 | #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ | 4543 | #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ |
| @@ -4900,7 +4643,7 @@ mark_stack (void) | |||
| 4900 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ | 4643 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ |
| 4901 | union aligned_jmpbuf { | 4644 | union aligned_jmpbuf { |
| 4902 | Lisp_Object o; | 4645 | Lisp_Object o; |
| 4903 | jmp_buf j; | 4646 | sys_jmp_buf j; |
| 4904 | } j; | 4647 | } j; |
| 4905 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; | 4648 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; |
| 4906 | #endif | 4649 | #endif |
| @@ -4936,7 +4679,7 @@ mark_stack (void) | |||
| 4936 | } | 4679 | } |
| 4937 | #endif /* GC_SETJMP_WORKS */ | 4680 | #endif /* GC_SETJMP_WORKS */ |
| 4938 | 4681 | ||
| 4939 | _setjmp (j.j); | 4682 | sys_setjmp (j.j); |
| 4940 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; | 4683 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; |
| 4941 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ | 4684 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ |
| 4942 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ | 4685 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ |
| @@ -4986,12 +4729,12 @@ valid_pointer_p (void *p) | |||
| 4986 | #endif | 4729 | #endif |
| 4987 | } | 4730 | } |
| 4988 | 4731 | ||
| 4989 | /* Return 2 if OBJ is a killed or special buffer object. | 4732 | /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a |
| 4990 | Return 1 if OBJ is a valid lisp object. | 4733 | valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we |
| 4991 | Return 0 if OBJ is NOT a valid lisp object. | 4734 | cannot validate OBJ. This function can be quite slow, so its primary |
| 4992 | Return -1 if we cannot validate OBJ. | 4735 | use is the manual debugging. The only exception is print_object, where |
| 4993 | This function can be quite slow, | 4736 | we use it to check whether the memory referenced by the pointer of |
| 4994 | so it should only be used in code for manual debugging. */ | 4737 | Lisp_Save_Value object contains valid objects. */ |
| 4995 | 4738 | ||
| 4996 | int | 4739 | int |
| 4997 | valid_lisp_object_p (Lisp_Object obj) | 4740 | valid_lisp_object_p (Lisp_Object obj) |
| @@ -5360,7 +5103,7 @@ staticpro (Lisp_Object *varaddress) | |||
| 5360 | { | 5103 | { |
| 5361 | staticvec[staticidx++] = varaddress; | 5104 | staticvec[staticidx++] = varaddress; |
| 5362 | if (staticidx >= NSTATICS) | 5105 | if (staticidx >= NSTATICS) |
| 5363 | emacs_abort (); | 5106 | fatal ("NSTATICS too small; try increasing and recompiling Emacs."); |
| 5364 | } | 5107 | } |
| 5365 | 5108 | ||
| 5366 | 5109 | ||
| @@ -5382,12 +5125,29 @@ inhibit_garbage_collection (void) | |||
| 5382 | /* Used to avoid possible overflows when | 5125 | /* Used to avoid possible overflows when |
| 5383 | converting from C to Lisp integers. */ | 5126 | converting from C to Lisp integers. */ |
| 5384 | 5127 | ||
| 5385 | static inline Lisp_Object | 5128 | static Lisp_Object |
| 5386 | bounded_number (EMACS_INT number) | 5129 | bounded_number (EMACS_INT number) |
| 5387 | { | 5130 | { |
| 5388 | return make_number (min (MOST_POSITIVE_FIXNUM, number)); | 5131 | return make_number (min (MOST_POSITIVE_FIXNUM, number)); |
| 5389 | } | 5132 | } |
| 5390 | 5133 | ||
| 5134 | /* Calculate total bytes of live objects. */ | ||
| 5135 | |||
| 5136 | static size_t | ||
| 5137 | total_bytes_of_live_objects (void) | ||
| 5138 | { | ||
| 5139 | size_t tot = 0; | ||
| 5140 | tot += total_conses * sizeof (struct Lisp_Cons); | ||
| 5141 | tot += total_symbols * sizeof (struct Lisp_Symbol); | ||
| 5142 | tot += total_markers * sizeof (union Lisp_Misc); | ||
| 5143 | tot += total_string_bytes; | ||
| 5144 | tot += total_vector_slots * word_size; | ||
| 5145 | tot += total_floats * sizeof (struct Lisp_Float); | ||
| 5146 | tot += total_intervals * sizeof (struct interval); | ||
| 5147 | tot += total_strings * sizeof (struct Lisp_String); | ||
| 5148 | return tot; | ||
| 5149 | } | ||
| 5150 | |||
| 5391 | DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", | 5151 | DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", |
| 5392 | doc: /* Reclaim storage for Lisp objects no longer needed. | 5152 | doc: /* Reclaim storage for Lisp objects no longer needed. |
| 5393 | Garbage collection happens automatically if you cons more than | 5153 | Garbage collection happens automatically if you cons more than |
| @@ -5405,7 +5165,6 @@ returns nil, because real GC can't be done. | |||
| 5405 | See Info node `(elisp)Garbage Collection'. */) | 5165 | See Info node `(elisp)Garbage Collection'. */) |
| 5406 | (void) | 5166 | (void) |
| 5407 | { | 5167 | { |
| 5408 | struct specbinding *bind; | ||
| 5409 | struct buffer *nextb; | 5168 | struct buffer *nextb; |
| 5410 | char stack_top_variable; | 5169 | char stack_top_variable; |
| 5411 | ptrdiff_t i; | 5170 | ptrdiff_t i; |
| @@ -5413,6 +5172,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5413 | ptrdiff_t count = SPECPDL_INDEX (); | 5172 | ptrdiff_t count = SPECPDL_INDEX (); |
| 5414 | EMACS_TIME start; | 5173 | EMACS_TIME start; |
| 5415 | Lisp_Object retval = Qnil; | 5174 | Lisp_Object retval = Qnil; |
| 5175 | size_t tot_before = 0; | ||
| 5416 | 5176 | ||
| 5417 | if (abort_on_gc) | 5177 | if (abort_on_gc) |
| 5418 | emacs_abort (); | 5178 | emacs_abort (); |
| @@ -5422,6 +5182,9 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5422 | if (pure_bytes_used_before_overflow) | 5182 | if (pure_bytes_used_before_overflow) |
| 5423 | return Qnil; | 5183 | return Qnil; |
| 5424 | 5184 | ||
| 5185 | /* Record this function, so it appears on the profiler's backtraces. */ | ||
| 5186 | record_in_backtrace (Qautomatic_gc, &Qnil, 0); | ||
| 5187 | |||
| 5425 | check_cons_list (); | 5188 | check_cons_list (); |
| 5426 | 5189 | ||
| 5427 | /* Don't keep undo information around forever. | 5190 | /* Don't keep undo information around forever. |
| @@ -5429,6 +5192,9 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5429 | FOR_EACH_BUFFER (nextb) | 5192 | FOR_EACH_BUFFER (nextb) |
| 5430 | compact_buffer (nextb); | 5193 | compact_buffer (nextb); |
| 5431 | 5194 | ||
| 5195 | if (profiler_memory_running) | ||
| 5196 | tot_before = total_bytes_of_live_objects (); | ||
| 5197 | |||
| 5432 | start = current_emacs_time (); | 5198 | start = current_emacs_time (); |
| 5433 | 5199 | ||
| 5434 | /* In case user calls debug_print during GC, | 5200 | /* In case user calls debug_print during GC, |
| @@ -5470,7 +5236,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5470 | if (garbage_collection_messages) | 5236 | if (garbage_collection_messages) |
| 5471 | message1_nolog ("Garbage collecting..."); | 5237 | message1_nolog ("Garbage collecting..."); |
| 5472 | 5238 | ||
| 5473 | BLOCK_INPUT; | 5239 | block_input (); |
| 5474 | 5240 | ||
| 5475 | shrink_regexp_cache (); | 5241 | shrink_regexp_cache (); |
| 5476 | 5242 | ||
| @@ -5484,11 +5250,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5484 | for (i = 0; i < staticidx; i++) | 5250 | for (i = 0; i < staticidx; i++) |
| 5485 | mark_object (*staticvec[i]); | 5251 | mark_object (*staticvec[i]); |
| 5486 | 5252 | ||
| 5487 | for (bind = specpdl; bind != specpdl_ptr; bind++) | 5253 | mark_specpdl (); |
| 5488 | { | ||
| 5489 | mark_object (bind->symbol); | ||
| 5490 | mark_object (bind->old_value); | ||
| 5491 | } | ||
| 5492 | mark_terminals (); | 5254 | mark_terminals (); |
| 5493 | mark_kboards (); | 5255 | mark_kboards (); |
| 5494 | 5256 | ||
| @@ -5522,7 +5284,6 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5522 | mark_object (handler->var); | 5284 | mark_object (handler->var); |
| 5523 | } | 5285 | } |
| 5524 | } | 5286 | } |
| 5525 | mark_backtrace (); | ||
| 5526 | #endif | 5287 | #endif |
| 5527 | 5288 | ||
| 5528 | #ifdef HAVE_WINDOW_SYSTEM | 5289 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -5587,12 +5348,12 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5587 | dump_zombies (); | 5348 | dump_zombies (); |
| 5588 | #endif | 5349 | #endif |
| 5589 | 5350 | ||
| 5590 | UNBLOCK_INPUT; | ||
| 5591 | |||
| 5592 | check_cons_list (); | 5351 | check_cons_list (); |
| 5593 | 5352 | ||
| 5594 | gc_in_progress = 0; | 5353 | gc_in_progress = 0; |
| 5595 | 5354 | ||
| 5355 | unblock_input (); | ||
| 5356 | |||
| 5596 | consing_since_gc = 0; | 5357 | consing_since_gc = 0; |
| 5597 | if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) | 5358 | if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) |
| 5598 | gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; | 5359 | gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; |
| @@ -5600,16 +5361,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5600 | gc_relative_threshold = 0; | 5361 | gc_relative_threshold = 0; |
| 5601 | if (FLOATP (Vgc_cons_percentage)) | 5362 | if (FLOATP (Vgc_cons_percentage)) |
| 5602 | { /* Set gc_cons_combined_threshold. */ | 5363 | { /* Set gc_cons_combined_threshold. */ |
| 5603 | double tot = 0; | 5364 | double tot = total_bytes_of_live_objects (); |
| 5604 | |||
| 5605 | tot += total_conses * sizeof (struct Lisp_Cons); | ||
| 5606 | tot += total_symbols * sizeof (struct Lisp_Symbol); | ||
| 5607 | tot += total_markers * sizeof (union Lisp_Misc); | ||
| 5608 | tot += total_string_bytes; | ||
| 5609 | tot += total_vector_slots * word_size; | ||
| 5610 | tot += total_floats * sizeof (struct Lisp_Float); | ||
| 5611 | tot += total_intervals * sizeof (struct interval); | ||
| 5612 | tot += total_strings * sizeof (struct Lisp_String); | ||
| 5613 | 5365 | ||
| 5614 | tot *= XFLOAT_DATA (Vgc_cons_percentage); | 5366 | tot *= XFLOAT_DATA (Vgc_cons_percentage); |
| 5615 | if (0 < tot) | 5367 | if (0 < tot) |
| @@ -5712,6 +5464,16 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5712 | 5464 | ||
| 5713 | gcs_done++; | 5465 | gcs_done++; |
| 5714 | 5466 | ||
| 5467 | /* Collect profiling data. */ | ||
| 5468 | if (profiler_memory_running) | ||
| 5469 | { | ||
| 5470 | size_t swept = 0; | ||
| 5471 | size_t tot_after = total_bytes_of_live_objects (); | ||
| 5472 | if (tot_before > tot_after) | ||
| 5473 | swept = tot_before - tot_after; | ||
| 5474 | malloc_probe (swept); | ||
| 5475 | } | ||
| 5476 | |||
| 5715 | return retval; | 5477 | return retval; |
| 5716 | } | 5478 | } |
| 5717 | 5479 | ||
| @@ -5865,29 +5627,30 @@ mark_buffer (struct buffer *buffer) | |||
| 5865 | mark_buffer (buffer->base_buffer); | 5627 | mark_buffer (buffer->base_buffer); |
| 5866 | } | 5628 | } |
| 5867 | 5629 | ||
| 5868 | /* Remove killed buffers or items whose car is a killed buffer | 5630 | /* Remove killed buffers or items whose car is a killed buffer from |
| 5869 | from LIST and return changed LIST. Called during GC. */ | 5631 | LIST, and mark other items. Return changed LIST, which is marked. */ |
| 5870 | 5632 | ||
| 5871 | static inline Lisp_Object | 5633 | static Lisp_Object |
| 5872 | discard_killed_buffers (Lisp_Object list) | 5634 | mark_discard_killed_buffers (Lisp_Object list) |
| 5873 | { | 5635 | { |
| 5874 | Lisp_Object tail, prev, tem; | 5636 | Lisp_Object tail, *prev = &list; |
| 5875 | 5637 | ||
| 5876 | for (tail = list, prev = Qnil; CONSP (tail); tail = XCDR (tail)) | 5638 | for (tail = list; CONSP (tail) && !CONS_MARKED_P (XCONS (tail)); |
| 5639 | tail = XCDR (tail)) | ||
| 5877 | { | 5640 | { |
| 5878 | tem = XCAR (tail); | 5641 | Lisp_Object tem = XCAR (tail); |
| 5879 | if (CONSP (tem)) | 5642 | if (CONSP (tem)) |
| 5880 | tem = XCAR (tem); | 5643 | tem = XCAR (tem); |
| 5881 | if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem))) | 5644 | if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem))) |
| 5645 | *prev = XCDR (tail); | ||
| 5646 | else | ||
| 5882 | { | 5647 | { |
| 5883 | if (NILP (prev)) | 5648 | CONS_MARK (XCONS (tail)); |
| 5884 | list = XCDR (tail); | 5649 | mark_object (XCAR (tail)); |
| 5885 | else | 5650 | prev = &XCDR_AS_LVALUE (tail); |
| 5886 | XSETCDR (prev, XCDR (tail)); | ||
| 5887 | } | 5651 | } |
| 5888 | else | ||
| 5889 | prev = tail; | ||
| 5890 | } | 5652 | } |
| 5653 | mark_object (tail); | ||
| 5891 | return list; | 5654 | return list; |
| 5892 | } | 5655 | } |
| 5893 | 5656 | ||
| @@ -5984,9 +5747,9 @@ mark_object (Lisp_Object arg) | |||
| 5984 | 5747 | ||
| 5985 | if (ptr->header.size & PSEUDOVECTOR_FLAG) | 5748 | if (ptr->header.size & PSEUDOVECTOR_FLAG) |
| 5986 | pvectype = ((ptr->header.size & PVEC_TYPE_MASK) | 5749 | pvectype = ((ptr->header.size & PVEC_TYPE_MASK) |
| 5987 | >> PSEUDOVECTOR_SIZE_BITS); | 5750 | >> PSEUDOVECTOR_AREA_BITS); |
| 5988 | else | 5751 | else |
| 5989 | pvectype = 0; | 5752 | pvectype = PVEC_NORMAL_VECTOR; |
| 5990 | 5753 | ||
| 5991 | if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER) | 5754 | if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER) |
| 5992 | CHECK_LIVE (live_vector_p); | 5755 | CHECK_LIVE (live_vector_p); |
| @@ -6027,45 +5790,33 @@ mark_object (Lisp_Object arg) | |||
| 6027 | break; | 5790 | break; |
| 6028 | 5791 | ||
| 6029 | case PVEC_FRAME: | 5792 | case PVEC_FRAME: |
| 6030 | { | 5793 | mark_vectorlike (ptr); |
| 6031 | struct frame *f = (struct frame *) ptr; | 5794 | mark_face_cache (((struct frame *) ptr)->face_cache); |
| 6032 | |||
| 6033 | /* For live frames, killed buffers are filtered out by | ||
| 6034 | store_frame_param. For dead frames, we do it here in | ||
| 6035 | attempt to help GC to reclaim killed buffers faster. */ | ||
| 6036 | if (!FRAME_LIVE_P (f)) | ||
| 6037 | fset_buffer_list (f, discard_killed_buffers (f->buffer_list)); | ||
| 6038 | |||
| 6039 | mark_vectorlike (ptr); | ||
| 6040 | mark_face_cache (f->face_cache); | ||
| 6041 | } | ||
| 6042 | break; | 5795 | break; |
| 6043 | 5796 | ||
| 6044 | case PVEC_WINDOW: | 5797 | case PVEC_WINDOW: |
| 6045 | { | 5798 | { |
| 6046 | struct window *w = (struct window *) ptr; | 5799 | struct window *w = (struct window *) ptr; |
| 6047 | bool leaf = NILP (w->hchild) && NILP (w->vchild); | ||
| 6048 | |||
| 6049 | /* For live windows, Lisp code filters out killed buffers | ||
| 6050 | from both buffer lists. For dead windows, we do it here | ||
| 6051 | in attempt to help GC to reclaim killed buffers faster. */ | ||
| 6052 | if (leaf && NILP (w->buffer)) | ||
| 6053 | { | ||
| 6054 | wset_prev_buffers | ||
| 6055 | (w, discard_killed_buffers (w->prev_buffers)); | ||
| 6056 | wset_next_buffers | ||
| 6057 | (w, discard_killed_buffers (w->next_buffers)); | ||
| 6058 | } | ||
| 6059 | 5800 | ||
| 6060 | mark_vectorlike (ptr); | 5801 | mark_vectorlike (ptr); |
| 6061 | /* Mark glyphs for leaf windows. Marking window | 5802 | |
| 5803 | /* Mark glyph matrices, if any. Marking window | ||
| 6062 | matrices is sufficient because frame matrices | 5804 | matrices is sufficient because frame matrices |
| 6063 | use the same glyph memory. */ | 5805 | use the same glyph memory. */ |
| 6064 | if (leaf && w->current_matrix) | 5806 | if (w->current_matrix) |
| 6065 | { | 5807 | { |
| 6066 | mark_glyph_matrix (w->current_matrix); | 5808 | mark_glyph_matrix (w->current_matrix); |
| 6067 | mark_glyph_matrix (w->desired_matrix); | 5809 | mark_glyph_matrix (w->desired_matrix); |
| 6068 | } | 5810 | } |
| 5811 | |||
| 5812 | /* Filter out killed buffers from both buffer lists | ||
| 5813 | in attempt to help GC to reclaim killed buffers faster. | ||
| 5814 | We can do it elsewhere for live windows, but this is the | ||
| 5815 | best place to do it for dead windows. */ | ||
| 5816 | wset_prev_buffers | ||
| 5817 | (w, mark_discard_killed_buffers (w->prev_buffers)); | ||
| 5818 | wset_next_buffers | ||
| 5819 | (w, mark_discard_killed_buffers (w->next_buffers)); | ||
| 6069 | } | 5820 | } |
| 6070 | break; | 5821 | break; |
| 6071 | 5822 | ||
| @@ -6074,6 +5825,9 @@ mark_object (Lisp_Object arg) | |||
| 6074 | struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; | 5825 | struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; |
| 6075 | 5826 | ||
| 6076 | mark_vectorlike (ptr); | 5827 | mark_vectorlike (ptr); |
| 5828 | mark_object (h->test.name); | ||
| 5829 | mark_object (h->test.user_hash_function); | ||
| 5830 | mark_object (h->test.user_cmp_function); | ||
| 6077 | /* If hash table is not weak, mark all keys and values. | 5831 | /* If hash table is not weak, mark all keys and values. |
| 6078 | For weak tables, mark only the vector. */ | 5832 | For weak tables, mark only the vector. */ |
| 6079 | if (NILP (h->weak)) | 5833 | if (NILP (h->weak)) |
| @@ -6180,20 +5934,27 @@ mark_object (Lisp_Object arg) | |||
| 6180 | 5934 | ||
| 6181 | case Lisp_Misc_Save_Value: | 5935 | case Lisp_Misc_Save_Value: |
| 6182 | XMISCANY (obj)->gcmarkbit = 1; | 5936 | XMISCANY (obj)->gcmarkbit = 1; |
| 6183 | #if GC_MARK_STACK | ||
| 6184 | { | 5937 | { |
| 6185 | register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); | 5938 | struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); |
| 6186 | /* If DOGC is set, POINTER is the address of a memory | 5939 | /* If `save_type' is zero, `data[0].pointer' is the address |
| 6187 | area containing INTEGER potential Lisp_Objects. */ | 5940 | of a memory area containing `data[1].integer' potential |
| 6188 | if (ptr->dogc) | 5941 | Lisp_Objects. */ |
| 5942 | if (GC_MARK_STACK && ptr->save_type == SAVE_TYPE_MEMORY) | ||
| 6189 | { | 5943 | { |
| 6190 | Lisp_Object *p = (Lisp_Object *) ptr->pointer; | 5944 | Lisp_Object *p = ptr->data[0].pointer; |
| 6191 | ptrdiff_t nelt; | 5945 | ptrdiff_t nelt; |
| 6192 | for (nelt = ptr->integer; nelt > 0; nelt--, p++) | 5946 | for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) |
| 6193 | mark_maybe_object (*p); | 5947 | mark_maybe_object (*p); |
| 6194 | } | 5948 | } |
| 5949 | else | ||
| 5950 | { | ||
| 5951 | /* Find Lisp_Objects in `data[N]' slots and mark them. */ | ||
| 5952 | int i; | ||
| 5953 | for (i = 0; i < SAVE_VALUE_SLOTS; i++) | ||
| 5954 | if (save_type (ptr, i) == SAVE_OBJECT) | ||
| 5955 | mark_object (ptr->data[i].object); | ||
| 5956 | } | ||
| 6195 | } | 5957 | } |
| 6196 | #endif | ||
| 6197 | break; | 5958 | break; |
| 6198 | 5959 | ||
| 6199 | case Lisp_Misc_Overlay: | 5960 | case Lisp_Misc_Overlay: |
| @@ -6619,19 +6380,14 @@ gc_sweep (void) | |||
| 6619 | 6380 | ||
| 6620 | /* Free all unmarked buffers */ | 6381 | /* Free all unmarked buffers */ |
| 6621 | { | 6382 | { |
| 6622 | register struct buffer *buffer = all_buffers, *prev = 0, *next; | 6383 | register struct buffer *buffer, **bprev = &all_buffers; |
| 6623 | 6384 | ||
| 6624 | total_buffers = 0; | 6385 | total_buffers = 0; |
| 6625 | while (buffer) | 6386 | for (buffer = all_buffers; buffer; buffer = *bprev) |
| 6626 | if (!VECTOR_MARKED_P (buffer)) | 6387 | if (!VECTOR_MARKED_P (buffer)) |
| 6627 | { | 6388 | { |
| 6628 | if (prev) | 6389 | *bprev = buffer->next; |
| 6629 | prev->header.next = buffer->header.next; | ||
| 6630 | else | ||
| 6631 | all_buffers = buffer->header.next.buffer; | ||
| 6632 | next = buffer->header.next.buffer; | ||
| 6633 | lisp_free (buffer); | 6390 | lisp_free (buffer); |
| 6634 | buffer = next; | ||
| 6635 | } | 6391 | } |
| 6636 | else | 6392 | else |
| 6637 | { | 6393 | { |
| @@ -6639,7 +6395,7 @@ gc_sweep (void) | |||
| 6639 | /* Do not use buffer_(set|get)_intervals here. */ | 6395 | /* Do not use buffer_(set|get)_intervals here. */ |
| 6640 | buffer->text->intervals = balance_intervals (buffer->text->intervals); | 6396 | buffer->text->intervals = balance_intervals (buffer->text->intervals); |
| 6641 | total_buffers++; | 6397 | total_buffers++; |
| 6642 | prev = buffer, buffer = buffer->header.next.buffer; | 6398 | bprev = &buffer->next; |
| 6643 | } | 6399 | } |
| 6644 | } | 6400 | } |
| 6645 | 6401 | ||
| @@ -6750,11 +6506,11 @@ die (const char *msg, const char *file, int line) | |||
| 6750 | { | 6506 | { |
| 6751 | fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n", | 6507 | fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n", |
| 6752 | file, line, msg); | 6508 | file, line, msg); |
| 6753 | fatal_error_backtrace (SIGABRT, INT_MAX); | 6509 | terminate_due_to_signal (SIGABRT, INT_MAX); |
| 6754 | } | 6510 | } |
| 6755 | #endif | 6511 | #endif |
| 6756 | 6512 | ||
| 6757 | /* Initialization */ | 6513 | /* Initialization. */ |
| 6758 | 6514 | ||
| 6759 | void | 6515 | void |
| 6760 | init_alloc_once (void) | 6516 | init_alloc_once (void) |
| @@ -6769,19 +6525,13 @@ init_alloc_once (void) | |||
| 6769 | #endif | 6525 | #endif |
| 6770 | 6526 | ||
| 6771 | #ifdef DOUG_LEA_MALLOC | 6527 | #ifdef DOUG_LEA_MALLOC |
| 6772 | mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ | 6528 | mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold. */ |
| 6773 | mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */ | 6529 | mallopt (M_MMAP_THRESHOLD, 64 * 1024); /* Mmap threshold. */ |
| 6774 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */ | 6530 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* Max. number of mmap'ed areas. */ |
| 6775 | #endif | 6531 | #endif |
| 6776 | init_strings (); | 6532 | init_strings (); |
| 6777 | init_vectors (); | 6533 | init_vectors (); |
| 6778 | 6534 | ||
| 6779 | #ifdef REL_ALLOC | ||
| 6780 | malloc_hysteresis = 32; | ||
| 6781 | #else | ||
| 6782 | malloc_hysteresis = 0; | ||
| 6783 | #endif | ||
| 6784 | |||
| 6785 | refill_memory_reserve (); | 6535 | refill_memory_reserve (); |
| 6786 | gc_cons_threshold = GC_DEFAULT_THRESHOLD; | 6536 | gc_cons_threshold = GC_DEFAULT_THRESHOLD; |
| 6787 | } | 6537 | } |
| @@ -6888,6 +6638,7 @@ do hash-consing of the objects allocated to pure space. */); | |||
| 6888 | DEFSYM (Qstring_bytes, "string-bytes"); | 6638 | DEFSYM (Qstring_bytes, "string-bytes"); |
| 6889 | DEFSYM (Qvector_slots, "vector-slots"); | 6639 | DEFSYM (Qvector_slots, "vector-slots"); |
| 6890 | DEFSYM (Qheap, "heap"); | 6640 | DEFSYM (Qheap, "heap"); |
| 6641 | DEFSYM (Qautomatic_gc, "Automatic GC"); | ||
| 6891 | 6642 | ||
| 6892 | DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); | 6643 | DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); |
| 6893 | DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); | 6644 | DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); |
| @@ -6921,7 +6672,8 @@ The time is in seconds as a floating point value. */); | |||
| 6921 | /* When compiled with GCC, GDB might say "No enum type named | 6672 | /* When compiled with GCC, GDB might say "No enum type named |
| 6922 | pvec_type" if we don't have at least one symbol with that type, and | 6673 | pvec_type" if we don't have at least one symbol with that type, and |
| 6923 | then xbacktrace could fail. Similarly for the other enums and | 6674 | then xbacktrace could fail. Similarly for the other enums and |
| 6924 | their values. */ | 6675 | their values. Some non-GCC compilers don't like these constructs. */ |
| 6676 | #ifdef __GNUC__ | ||
| 6925 | union | 6677 | union |
| 6926 | { | 6678 | { |
| 6927 | enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS; | 6679 | enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS; |
| @@ -6941,3 +6693,4 @@ union | |||
| 6941 | enum lsb_bits lsb_bits; | 6693 | enum lsb_bits lsb_bits; |
| 6942 | #endif | 6694 | #endif |
| 6943 | } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; | 6695 | } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; |
| 6696 | #endif /* __GNUC__ */ | ||