aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorStephen Berman2013-06-14 22:07:55 +0200
committerStephen Berman2013-06-14 22:07:55 +0200
commitbd358779861f265a7acff31ead40172735af693e (patch)
tree345217a9889dbd29b09bdc80a94265c17719d41f /src/alloc.c
parent2a97b47f0878cbda86cb6ba0e7e744924810b70e (diff)
parentf7394b12358ae453a0c8b85fc307afc1b740010d (diff)
downloademacs-bd358779861f265a7acff31ead40172735af693e.tar.gz
emacs-bd358779861f265a7acff31ead40172735af693e.zip
Merge from trunk.
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c1029
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
3Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012 3Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
4 Free Software Foundation, Inc. 4Foundation, Inc.
5 5
6This file is part of GNU Emacs. 6This 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
68extern 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
93extern size_t _bytes_used;
94extern size_t __malloc_extra_blocks;
95extern void *_malloc_internal (size_t);
96extern 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
122static 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
209static 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;
268static Lisp_Object Qbuffers; 202static Lisp_Object Qbuffers;
269static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; 203static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
270static Lisp_Object Qgc_cons_threshold; 204static Lisp_Object Qgc_cons_threshold;
205Lisp_Object Qautomatic_gc;
271Lisp_Object Qchar_table_extra_slots; 206Lisp_Object Qchar_table_extra_slots;
272 207
273/* Hook run after GC has finished. */ 208/* Hook run after GC has finished. */
274 209
275static Lisp_Object Qpost_gc_hook; 210static Lisp_Object Qpost_gc_hook;
276 211
212static void free_save_value (Lisp_Object);
277static void mark_terminals (void); 213static void mark_terminals (void);
278static void gc_sweep (void); 214static void gc_sweep (void);
279static Lisp_Object make_pure_vector (ptrdiff_t); 215static Lisp_Object make_pure_vector (ptrdiff_t);
280static void mark_glyph_matrix (struct glyph_matrix *);
281static void mark_face_cache (struct face_cache *);
282static void mark_buffer (struct buffer *); 216static void mark_buffer (struct buffer *);
283 217
284#if !defined REL_ALLOC || defined SYSTEM_MALLOC 218#if !defined REL_ALLOC || defined SYSTEM_MALLOC
285static void refill_memory_reserve (void); 219static void refill_memory_reserve (void);
286#endif 220#endif
287static struct Lisp_String *allocate_string (void);
288static void compact_small_strings (void); 221static void compact_small_strings (void);
289static void free_large_strings (void); 222static void free_large_strings (void);
290static void sweep_strings (void);
291static void free_misc (Lisp_Object);
292extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; 223extern 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
298enum mem_type 229enum 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
318static 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;
396static struct mem_node mem_z; 323static struct mem_node mem_z;
397#define MEM_NIL &mem_z 324#define MEM_NIL &mem_z
398 325
399static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
400static void lisp_free (void *);
401static void mark_stack (void);
402static bool live_vector_p (struct mem_node *, void *);
403static bool live_buffer_p (struct mem_node *, void *);
404static bool live_string_p (struct mem_node *, void *);
405static bool live_cons_p (struct mem_node *, void *);
406static bool live_symbol_p (struct mem_node *, void *);
407static bool live_float_p (struct mem_node *, void *);
408static bool live_misc_p (struct mem_node *, void *);
409static void mark_maybe_object (Lisp_Object);
410static void mark_memory (void *, void *);
411#if GC_MARK_STACK || defined GC_MALLOC_CHECK 326#if GC_MARK_STACK || defined GC_MALLOC_CHECK
412static void mem_init (void);
413static struct mem_node *mem_insert (void *, void *, enum mem_type); 327static struct mem_node *mem_insert (void *, void *, enum mem_type);
414static void mem_insert_fixup (struct mem_node *); 328static void mem_insert_fixup (struct mem_node *);
415#endif
416static void mem_rotate_left (struct mem_node *); 329static void mem_rotate_left (struct mem_node *);
417static void mem_rotate_right (struct mem_node *); 330static void mem_rotate_right (struct mem_node *);
418static void mem_delete (struct mem_node *); 331static void mem_delete (struct mem_node *);
419static void mem_delete_fixup (struct mem_node *); 332static void mem_delete_fixup (struct mem_node *);
420static inline struct mem_node *mem_find (void *); 333static struct mem_node *mem_find (void *);
421
422
423#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
424static 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
441static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; 350static 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
608static 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
612static void * 500static void *
613overrun_check_malloc (size_t size) 501overrun_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 *
638overrun_check_realloc (void *block, size_t size) 524overrun_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
603bool block_input_in_memory_allocators EXTERNALLY_VISIBLE;
604static void
605malloc_block_input (void)
606{
607 if (block_input_in_memory_allocators)
608 block_input ();
609}
610static void
611malloc_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
726void * 632void *
@@ -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
846void * 758void *
847xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min, 759xpalloc (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
808void
809xputenv (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
896Lisp_Object 817Lisp_Object
897safe_alloca_unwind (Lisp_Object arg) 818safe_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 *
911record_xmalloc (size_t size) 827record_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
1235extern void * (*__malloc_hook) (size_t, const void *);
1236extern void * (*__realloc_hook) (void *, size_t, const void *);
1237extern void (*__free_hook) (void *, const void *);
1238/* Else declared in malloc.h, perhaps with an extra arg. */
1239#endif /* DOUG_LEA_MALLOC */
1240static void * (*old_malloc_hook) (size_t, const void *);
1241static void * (*old_realloc_hook) (void *, size_t, const void*);
1242static 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
1251static bool dont_register_blocks;
1252#endif
1253
1254static size_t bytes_used_when_reconsidered;
1255
1256/* Value of _bytes_used, when spare_memory was freed. */
1257
1258static size_t bytes_used_when_full;
1259
1260/* This function is used as the hook for free to call. */
1261
1262static void
1263emacs_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
1310static void *
1311emacs_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
1357static void *
1358emacs_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
1419void
1420reset_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
1431void
1432uninterrupt_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
1481struct interval_block 1150struct 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'. */
2604static struct Lisp_Vector *
2605next_in_free_list (struct Lisp_Vector *v)
2606{
2607 intptr_t i = XLI (v->contents[0]);
2608 return (struct Lisp_Vector *) i;
2609}
2610static void
2611set_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
2633struct 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
2952struct vector_block 2648struct 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
2969static struct Lisp_Vector *large_vectors; 2665static 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)
3010static struct Lisp_Vector * 2706static struct Lisp_Vector *
3011allocate_vector_from_block (size_t nbytes) 2707allocate_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) \ 2772static ptrdiff_t
3085 (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \ 2773vector_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
3092sweep_vectors (void) 2798sweep_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
3265struct Lisp_Vector * 2976struct Lisp_Vector *
3266allocate_pseudovector (int memlen, int lisplen, int tag) 2977allocate_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.
3372usage: (vector &rest OBJECTS) */) 3087usage: (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.
3416usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) 3128usage: (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
3484DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3192DEFUN ("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.
3486Its value and function definition are void, and its property list is nil. */) 3194Its 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
3615static void 3319void
3616free_misc (Lisp_Object misc) 3320free_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
3332verify (SAVE_UNUSED == 0);
3333verify ((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
3629Lisp_Object 3338Lisp_Object
3630make_save_value (void *pointer, ptrdiff_t integer) 3339make_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
3378Lisp_Object
3379make_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
3391static void
3392free_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
3645Lisp_Object 3400Lisp_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
3883static inline struct mem_node * 3632static struct mem_node *
3884mem_find (void *start) 3633mem_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
4259static inline bool 4008static bool
4260live_string_p (struct mem_node *m, void *p) 4009live_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
4282static inline bool 4031static bool
4283live_cons_p (struct mem_node *m, void *p) 4032live_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
4308static inline bool 4057static bool
4309live_symbol_p (struct mem_node *m, void *p) 4058live_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
4334static inline bool 4083static bool
4335live_float_p (struct mem_node *m, void *p) 4084live_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
4358static inline bool 4107static bool
4359live_misc_p (struct mem_node *m, void *p) 4108live_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
4384static inline bool 4133static bool
4385live_vector_p (struct mem_node *m, void *p) 4134live_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
4420static inline bool 4168static bool
4421live_buffer_p (struct mem_node *m, void *p) 4169live_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
4486static inline void 4234static void
4487mark_maybe_object (Lisp_Object obj) 4235mark_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
4555static inline void 4303static void
4556mark_maybe_pointer (void *p) 4304mark_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
4721static bool setjmp_tested_p; 4464static 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
4996int 4739int
4997valid_lisp_object_p (Lisp_Object obj) 4740valid_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
5385static inline Lisp_Object 5128static Lisp_Object
5386bounded_number (EMACS_INT number) 5129bounded_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
5136static size_t
5137total_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
5391DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", 5151DEFUN ("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.
5393Garbage collection happens automatically if you cons more than 5153Garbage collection happens automatically if you cons more than
@@ -5405,7 +5165,6 @@ returns nil, because real GC can't be done.
5405See Info node `(elisp)Garbage Collection'. */) 5165See 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
5871static inline Lisp_Object 5633static Lisp_Object
5872discard_killed_buffers (Lisp_Object list) 5634mark_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
6759void 6515void
6760init_alloc_once (void) 6516init_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__
6925union 6677union
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__ */