1 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
3 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #ifdef ENABLE_CHECKING
26 #include <signal.h> /* For SIGABRT. */
37 #include "intervals.h"
38 #include "character.h"
43 #include "termhooks.h" /* For struct terminal. */
44 #ifdef HAVE_WINDOW_SYSTEM
46 #endif /* HAVE_WINDOW_SYSTEM */
49 #include <execinfo.h> /* For backtrace. */
51 #if (defined ENABLE_CHECKING \
52 && defined HAVE_VALGRIND_VALGRIND_H \
53 && !defined USE_VALGRIND)
54 # define USE_VALGRIND 1
58 #include <valgrind/valgrind.h>
59 #include <valgrind/memcheck.h>
60 static bool valgrind_p
;
71 #include "w32heap.h" /* for sbrk */
74 /* Default value of gc_cons_threshold (see below). */
76 #define GC_DEFAULT_THRESHOLD (100000 * word_size)
78 /* Global variables. */
79 struct emacs_globals globals
;
81 /* Number of bytes of consing done since the last gc. */
83 EMACS_INT consing_since_gc
;
85 /* Similar minimum, computed from Vgc_cons_percentage. */
87 EMACS_INT gc_relative_threshold
;
89 /* Minimum number of bytes of consing since GC before next GC,
90 when memory is full. */
92 EMACS_INT memory_full_cons_threshold
= 1 << 10;
98 /* True means abort if try to GC.
99 This is for code which is written on the assumption that
100 no GC will happen, so as to verify that assumption. */
104 /* Number of live and free conses etc. */
106 static EMACS_INT total_conses
, total_markers
, total_symbols
, total_buffers
;
107 static EMACS_INT total_free_conses
, total_free_markers
, total_free_symbols
;
108 static EMACS_INT total_free_floats
, total_floats
;
110 /* Points to memory space allocated as "spare", to be freed if we run
113 static void *spare_memory
;
115 /* Amount of spare memory to keep in large reserve block, or to see
116 whether this much is available when malloc fails on a larger request. */
118 #define SPARE_MEMORY (1 << 15)
120 /* If nonzero, this is a warning delivered by malloc and not yet
123 const char *pending_malloc_warning
;
125 static Lisp_Object Qgc_cons_threshold
;
126 Lisp_Object Qchar_table_extra_slots
;
128 /* Hook run after GC has finished. */
130 static Lisp_Object Qpost_gc_hook
;
132 #if !defined REL_ALLOC || defined SYSTEM_MALLOC
133 static void refill_memory_reserve (void);
135 static Lisp_Object
make_empty_string (int);
136 extern Lisp_Object
which_symbols (Lisp_Object
, EMACS_INT
) EXTERNALLY_VISIBLE
;
142 /* Recording what needs to be marked for gc. */
144 struct gcpro
*gcprolist
;
146 /************************************************************************
148 ************************************************************************/
150 /* Function malloc calls this if it finds we are near exhausting storage. */
153 malloc_warning (const char *str
)
155 pending_malloc_warning
= str
;
159 /* Display an already-pending malloc warning. */
162 display_malloc_warning (void)
164 call3 (intern ("display-warning"),
166 build_string (pending_malloc_warning
),
167 intern ("emergency"));
168 pending_malloc_warning
= 0;
171 /* Called if we can't allocate relocatable space for a buffer. */
174 buffer_memory_full (ptrdiff_t nbytes
)
176 /* If buffers use the relocating allocator, no need to free
177 spare_memory, because we may have plenty of malloc space left
178 that we could get, and if we don't, the malloc that fails will
179 itself cause spare_memory to be freed. If buffers don't use the
180 relocating allocator, treat this like any other failing
184 memory_full (nbytes
);
186 /* This used to call error, but if we've run out of memory, we could
187 get infinite recursion trying to build the string. */
188 xsignal (Qnil
, Vmemory_signal_data
);
192 /* Like GC_MALLOC but check for no memory. */
195 xmalloc (size_t size
)
197 void *val
= GC_MALLOC (size
);
203 /* Like the above, but zeroes out the memory just allocated. */
206 xzalloc (size_t size
)
208 return xmalloc (size
);
211 /* Like GC_REALLOC but check for no memory. */
214 xrealloc (void *block
, size_t size
)
216 void *val
= GC_REALLOC (block
, size
);
228 /* Allocate pointerless memory. */
231 xmalloc_atomic (size_t size
)
233 void *val
= GC_MALLOC_ATOMIC (size
);
240 xzalloc_atomic (size_t size
)
242 return xmalloc_atomic (size
);
245 /* Allocate uncollectable memory. */
248 xmalloc_uncollectable (size_t size
)
250 void *val
= GC_MALLOC_UNCOLLECTABLE (size
);
256 /* Allocate memory, but if memory is exhausted, return NULL instead of
257 signalling an error. */
260 xmalloc_unsafe (size_t size
)
262 return GC_MALLOC (size
);
265 /* Allocate pointerless memory, but if memory is exhausted, return
266 NULL instead of signalling an error. */
269 xmalloc_atomic_unsafe (size_t size
)
271 return GC_MALLOC_ATOMIC (size
);
274 /* Other parts of Emacs pass large int values to allocator functions
275 expecting ptrdiff_t. This is portable in practice, but check it to
277 verify (INT_MAX
<= PTRDIFF_MAX
);
280 /* Allocate an array of NITEMS items, each of size ITEM_SIZE.
281 Signal an error on memory exhaustion. */
284 xnmalloc (ptrdiff_t nitems
, ptrdiff_t item_size
)
286 eassert (0 <= nitems
&& 0 < item_size
);
287 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
288 memory_full (SIZE_MAX
);
289 return xmalloc (nitems
* item_size
);
292 /* Like xnmalloc for pointerless objects. */
295 xnmalloc_atomic (ptrdiff_t nitems
, ptrdiff_t item_size
)
297 eassert (0 <= nitems
&& 0 < item_size
);
298 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
299 memory_full (SIZE_MAX
);
300 return xmalloc_atomic (nitems
* item_size
);
303 /* Reallocate an array PA to make it of NITEMS items, each of size ITEM_SIZE.
304 Signal an error on memory exhaustion. */
307 xnrealloc (void *pa
, ptrdiff_t nitems
, ptrdiff_t item_size
)
309 eassert (0 <= nitems
&& 0 < item_size
);
310 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
311 memory_full (SIZE_MAX
);
312 return xrealloc (pa
, nitems
* item_size
);
316 /* Grow PA, which points to an array of *NITEMS items, and return the
317 location of the reallocated array, updating *NITEMS to reflect its
318 new size. The new array will contain at least NITEMS_INCR_MIN more
319 items, but will not contain more than NITEMS_MAX items total.
320 ITEM_SIZE is the size of each item, in bytes.
322 ITEM_SIZE and NITEMS_INCR_MIN must be positive. *NITEMS must be
323 nonnegative. If NITEMS_MAX is -1, it is treated as if it were
326 If PA is null, then allocate a new array instead of reallocating
329 If memory exhaustion occurs, set *NITEMS to zero if PA is null, and
330 signal an error (i.e., do not return).
332 Thus, to grow an array A without saving its old contents, do
333 { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }.
334 The A = NULL avoids a dangling pointer if xpalloc exhausts memory
335 and signals an error, and later this code is reexecuted and
336 attempts to free A. */
339 xpalloc (void *pa
, ptrdiff_t *nitems
, ptrdiff_t nitems_incr_min
,
340 ptrdiff_t nitems_max
, ptrdiff_t item_size
)
342 /* The approximate size to use for initial small allocation
343 requests. This is the largest "small" request for the GNU C
345 enum { DEFAULT_MXFAST
= 64 * sizeof (size_t) / 4 };
347 /* If the array is tiny, grow it to about (but no greater than)
348 DEFAULT_MXFAST bytes. Otherwise, grow it by about 50%. */
349 ptrdiff_t n
= *nitems
;
350 ptrdiff_t tiny_max
= DEFAULT_MXFAST
/ item_size
- n
;
351 ptrdiff_t half_again
= n
>> 1;
352 ptrdiff_t incr_estimate
= max (tiny_max
, half_again
);
354 /* Adjust the increment according to three constraints: NITEMS_INCR_MIN,
355 NITEMS_MAX, and what the C language can represent safely. */
356 ptrdiff_t C_language_max
= min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
;
357 ptrdiff_t n_max
= (0 <= nitems_max
&& nitems_max
< C_language_max
358 ? nitems_max
: C_language_max
);
359 ptrdiff_t nitems_incr_max
= n_max
- n
;
360 ptrdiff_t incr
= max (nitems_incr_min
, min (incr_estimate
, nitems_incr_max
));
362 eassert (0 < item_size
&& 0 < nitems_incr_min
&& 0 <= n
&& -1 <= nitems_max
);
365 if (nitems_incr_max
< incr
)
366 memory_full (SIZE_MAX
);
368 pa
= xrealloc (pa
, n
* item_size
);
374 /* Like strdup, but uses xmalloc. */
377 xstrdup (const char *s
)
381 size
= strlen (s
) + 1;
382 return memcpy (xmalloc_atomic (size
), s
, size
);
385 /* Like above, but duplicates Lisp string to C string. */
388 xlispstrdup (Lisp_Object string
)
390 ptrdiff_t size
= SBYTES (string
) + 1;
391 return memcpy (xmalloc_atomic (size
), SSDATA (string
), size
);
394 /* Assign to *PTR a copy of STRING, freeing any storage *PTR formerly
395 pointed to. If STRING is null, assign it without copying anything.
396 Allocate before freeing, to avoid a dangling pointer if allocation
400 dupstring (char **ptr
, char const *string
)
403 *ptr
= string
? xstrdup (string
) : 0;
408 /* Like putenv, but (1) use the equivalent of xmalloc and (2) the
409 argument is a const pointer. */
412 xputenv (char const *string
)
414 if (putenv ((char *) string
) != 0)
418 /* Return a newly allocated memory block of SIZE bytes, remembering
419 to free it when unwinding. */
421 record_xmalloc (size_t size
)
423 void *p
= xmalloc (size
);
424 record_unwind_protect_ptr (xfree
, p
);
428 /***********************************************************************
430 ***********************************************************************/
432 /* Return a new interval. */
437 INTERVAL val
= xmalloc (sizeof (struct interval
));
438 RESET_INTERVAL (val
);
442 /***********************************************************************
444 ***********************************************************************/
446 /* Initialize string allocation. Called from init_alloc_once. */
451 empty_unibyte_string
= make_empty_string (0);
452 empty_multibyte_string
= make_empty_string (1);
455 /* Return a new Lisp_String. */
457 static struct Lisp_String
*
458 allocate_string (void)
460 struct Lisp_String
*p
;
462 p
= xmalloc (sizeof *p
);
463 SCM_NEWSMOB (p
->self
, lisp_string_tag
, p
);
468 /* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes,
469 plus a NUL byte at the end. Allocate an sdata structure for S, and
470 set S->data to its `u.data' member. Store a NUL byte at the end of
471 S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free
472 S->data if it was initially non-null. */
475 allocate_string_data (struct Lisp_String
*s
,
476 EMACS_INT nchars
, EMACS_INT nbytes
)
480 if (STRING_BYTES_BOUND
< nbytes
)
483 data
= GC_MALLOC_ATOMIC (nbytes
+ 1);
486 s
->size_byte
= nbytes
;
487 s
->data
[nbytes
] = '\0';
491 string_overflow (void)
493 error ("Maximum string size exceeded");
497 make_empty_string (int multibyte
)
500 struct Lisp_String
*s
;
502 s
= allocate_string ();
503 allocate_string_data (s
, 0, 0);
504 XSETSTRING (string
, s
);
506 STRING_SET_UNIBYTE (string
);
511 DEFUN ("make-string", Fmake_string
, Smake_string
, 2, 2, 0,
512 doc
: /* Return a newly created string of length LENGTH, with INIT in each element.
513 LENGTH must be an integer.
514 INIT must be an integer that represents a character. */)
515 (Lisp_Object length
, Lisp_Object init
)
517 register Lisp_Object val
;
521 CHECK_NATNUM (length
);
522 CHECK_CHARACTER (init
);
525 if (ASCII_CHAR_P (c
))
527 nbytes
= XINT (length
);
528 val
= make_uninit_string (nbytes
);
529 memset (SDATA (val
), c
, nbytes
);
530 SDATA (val
)[nbytes
] = 0;
534 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
535 ptrdiff_t len
= CHAR_STRING (c
, str
);
536 EMACS_INT string_len
= XINT (length
);
537 unsigned char *p
, *beg
, *end
;
539 if (string_len
> STRING_BYTES_BOUND
/ len
)
541 nbytes
= len
* string_len
;
542 val
= make_uninit_multibyte_string (string_len
, nbytes
);
543 for (beg
= SDATA (val
), p
= beg
, end
= beg
+ nbytes
; p
< end
; p
+= len
)
545 /* First time we just copy `str' to the data of `val'. */
547 memcpy (p
, str
, len
);
550 /* Next time we copy largest possible chunk from
551 initialized to uninitialized part of `val'. */
552 len
= min (p
- beg
, end
- p
);
553 memcpy (p
, beg
, len
);
562 /* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
566 bool_vector_fill (Lisp_Object a
, Lisp_Object init
)
568 EMACS_INT nbits
= bool_vector_size (a
);
571 unsigned char *data
= bool_vector_uchar_data (a
);
572 int pattern
= NILP (init
) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR
) - 1;
573 ptrdiff_t nbytes
= bool_vector_bytes (nbits
);
574 int last_mask
= ~ (~0u << ((nbits
- 1) % BOOL_VECTOR_BITS_PER_CHAR
+ 1));
575 memset (data
, pattern
, nbytes
- 1);
576 data
[nbytes
- 1] = pattern
& last_mask
;
581 /* Return a newly allocated, uninitialized bool vector of size NBITS. */
584 make_uninit_bool_vector (EMACS_INT nbits
)
587 EMACS_INT words
= bool_vector_words (nbits
);
588 EMACS_INT word_bytes
= words
* sizeof (bits_word
);
589 EMACS_INT needed_elements
= ((bool_header_size
- header_size
+ word_bytes
592 struct Lisp_Bool_Vector
*p
593 = (struct Lisp_Bool_Vector
*) allocate_vector (needed_elements
);
595 XSETPVECTYPESIZE (XVECTOR (val
), PVEC_BOOL_VECTOR
, 0, 0);
598 /* Clear padding at the end. */
600 p
->data
[words
- 1] = 0;
605 DEFUN ("make-bool-vector", Fmake_bool_vector
, Smake_bool_vector
, 2, 2, 0,
606 doc
: /* Return a new bool-vector of length LENGTH, using INIT for each element.
607 LENGTH must be a number. INIT matters only in whether it is t or nil. */)
608 (Lisp_Object length
, Lisp_Object init
)
612 CHECK_NATNUM (length
);
613 val
= make_uninit_bool_vector (XFASTINT (length
));
614 return bool_vector_fill (val
, init
);
617 DEFUN ("bool-vector", Fbool_vector
, Sbool_vector
, 0, MANY
, 0,
618 doc
: /* Return a new bool-vector with specified arguments as elements.
619 Any number of arguments, even zero arguments, are allowed.
620 usage: (bool-vector &rest OBJECTS) */)
621 (ptrdiff_t nargs
, Lisp_Object
*args
)
626 vector
= make_uninit_bool_vector (nargs
);
627 for (i
= 0; i
< nargs
; i
++)
628 bool_vector_set (vector
, i
, !NILP (args
[i
]));
633 /* Make a string from NBYTES bytes at CONTENTS, and compute the number
634 of characters from the contents. This string may be unibyte or
635 multibyte, depending on the contents. */
638 make_string (const char *contents
, ptrdiff_t nbytes
)
640 register Lisp_Object val
;
641 ptrdiff_t nchars
, multibyte_nbytes
;
643 parse_str_as_multibyte ((const unsigned char *) contents
, nbytes
,
644 &nchars
, &multibyte_nbytes
);
645 if (nbytes
== nchars
|| nbytes
!= multibyte_nbytes
)
646 /* CONTENTS contains no multibyte sequences or contains an invalid
647 multibyte sequence. We must make unibyte string. */
648 val
= make_unibyte_string (contents
, nbytes
);
650 val
= make_multibyte_string (contents
, nchars
, nbytes
);
655 /* Make an unibyte string from LENGTH bytes at CONTENTS. */
658 make_unibyte_string (const char *contents
, ptrdiff_t length
)
660 register Lisp_Object val
;
661 val
= make_uninit_string (length
);
662 memcpy (SDATA (val
), contents
, length
);
667 /* Make a multibyte string from NCHARS characters occupying NBYTES
668 bytes at CONTENTS. */
671 make_multibyte_string (const char *contents
,
672 ptrdiff_t nchars
, ptrdiff_t nbytes
)
674 register Lisp_Object val
;
675 val
= make_uninit_multibyte_string (nchars
, nbytes
);
676 memcpy (SDATA (val
), contents
, nbytes
);
681 /* Make a string from NCHARS characters occupying NBYTES bytes at
682 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
685 make_string_from_bytes (const char *contents
,
686 ptrdiff_t nchars
, ptrdiff_t nbytes
)
688 register Lisp_Object val
;
689 val
= make_uninit_multibyte_string (nchars
, nbytes
);
690 memcpy (SDATA (val
), contents
, nbytes
);
691 if (SBYTES (val
) == SCHARS (val
))
692 STRING_SET_UNIBYTE (val
);
697 /* Make a string from NCHARS characters occupying NBYTES bytes at
698 CONTENTS. The argument MULTIBYTE controls whether to label the
699 string as multibyte. If NCHARS is negative, it counts the number of
700 characters by itself. */
703 make_specified_string (const char *contents
,
704 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
711 nchars
= multibyte_chars_in_text ((const unsigned char *) contents
,
716 val
= make_uninit_multibyte_string (nchars
, nbytes
);
717 memcpy (SDATA (val
), contents
, nbytes
);
719 STRING_SET_UNIBYTE (val
);
724 /* Return an unibyte Lisp_String set up to hold LENGTH characters
725 occupying LENGTH bytes. */
728 make_uninit_string (EMACS_INT length
)
733 return empty_unibyte_string
;
734 val
= make_uninit_multibyte_string (length
, length
);
735 STRING_SET_UNIBYTE (val
);
740 /* Return a multibyte Lisp_String set up to hold NCHARS characters
741 which occupy NBYTES bytes. */
744 make_uninit_multibyte_string (EMACS_INT nchars
, EMACS_INT nbytes
)
747 struct Lisp_String
*s
;
752 return empty_multibyte_string
;
754 s
= allocate_string ();
756 allocate_string_data (s
, nchars
, nbytes
);
757 XSETSTRING (string
, s
);
761 /* Print arguments to BUF according to a FORMAT, then return
762 a Lisp_String initialized with the data from BUF. */
765 make_formatted_string (char *buf
, const char *format
, ...)
770 va_start (ap
, format
);
771 length
= vsprintf (buf
, format
, ap
);
773 return make_string (buf
, length
);
777 /***********************************************************************
779 ***********************************************************************/
781 /* Return a new float object with value FLOAT_VALUE. */
784 make_float (double float_value
)
786 return scm_from_double (float_value
);
790 /***********************************************************************
792 ***********************************************************************/
794 DEFUN ("cons", Fcons
, Scons
, 2, 2, 0,
795 doc
: /* Create a new cons, give it CAR and CDR as components, and return it. */)
796 (Lisp_Object car
, Lisp_Object cdr
)
798 return scm_cons (car
, cdr
);
801 /* Make a list of 1, 2, 3, 4 or 5 specified objects. */
804 list1 (Lisp_Object arg1
)
806 return Fcons (arg1
, Qnil
);
810 list2 (Lisp_Object arg1
, Lisp_Object arg2
)
812 return Fcons (arg1
, Fcons (arg2
, Qnil
));
817 list3 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
819 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Qnil
)));
824 list4 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
)
826 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
, Qnil
))));
831 list5 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
, Lisp_Object arg5
)
833 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
,
834 Fcons (arg5
, Qnil
)))));
837 /* Make a list of COUNT Lisp_Objects, where ARG is the
838 first one. Allocate conses from pure space if TYPE
839 is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
842 listn (enum constype type
, ptrdiff_t count
, Lisp_Object arg
, ...)
846 Lisp_Object val
, *objp
;
848 /* Change to SAFE_ALLOCA if you hit this eassert. */
849 eassert (count
<= MAX_ALLOCA
/ word_size
);
851 objp
= alloca (count
* word_size
);
854 for (i
= 1; i
< count
; i
++)
855 objp
[i
] = va_arg (ap
, Lisp_Object
);
858 for (val
= Qnil
, i
= count
- 1; i
>= 0; i
--)
860 if (type
== CONSTYPE_PURE
)
861 val
= pure_cons (objp
[i
], val
);
862 else if (type
== CONSTYPE_HEAP
)
863 val
= Fcons (objp
[i
], val
);
870 DEFUN ("list", Flist
, Slist
, 0, MANY
, 0,
871 doc
: /* Return a newly created list with specified arguments as elements.
872 Any number of arguments, even zero arguments, are allowed.
873 usage: (list &rest OBJECTS) */)
874 (ptrdiff_t nargs
, Lisp_Object
*args
)
876 register Lisp_Object val
;
882 val
= Fcons (args
[nargs
], val
);
888 DEFUN ("make-list", Fmake_list
, Smake_list
, 2, 2, 0,
889 doc
: /* Return a newly created list of length LENGTH, with each element being INIT. */)
890 (register Lisp_Object length
, Lisp_Object init
)
892 register Lisp_Object val
;
893 register EMACS_INT size
;
895 CHECK_NATNUM (length
);
896 size
= XFASTINT (length
);
901 val
= Fcons (init
, val
);
906 val
= Fcons (init
, val
);
911 val
= Fcons (init
, val
);
916 val
= Fcons (init
, val
);
921 val
= Fcons (init
, val
);
936 /***********************************************************************
938 ***********************************************************************/
940 /* The only vector with 0 slots, allocated from pure space. */
942 Lisp_Object zero_vector
;
944 /* Called once to initialize vector allocation. */
949 struct Lisp_Vector
*p
= xmalloc (header_size
);
951 SCM_NEWSMOB (p
->header
.self
, lisp_vectorlike_tag
, p
);
953 XSETVECTOR (zero_vector
, p
);
956 /* Value is a pointer to a newly allocated Lisp_Vector structure
957 with room for LEN Lisp_Objects. */
959 static struct Lisp_Vector
*
960 allocate_vectorlike (ptrdiff_t len
)
962 struct Lisp_Vector
*p
;
965 p
= XVECTOR (zero_vector
);
968 p
= xmalloc (header_size
+ len
* word_size
);
969 SCM_NEWSMOB (p
->header
.self
, lisp_vectorlike_tag
, p
);
976 /* Allocate a vector with LEN slots. */
979 allocate_vector (EMACS_INT len
)
981 struct Lisp_Vector
*v
;
982 ptrdiff_t nbytes_max
= min (PTRDIFF_MAX
, SIZE_MAX
);
984 if (min ((nbytes_max
- header_size
) / word_size
, MOST_POSITIVE_FIXNUM
) < len
)
985 memory_full (SIZE_MAX
);
986 v
= allocate_vectorlike (len
);
987 v
->header
.size
= len
;
992 /* Allocate other vector-like structures. */
995 allocate_pseudovector (int memlen
, int lisplen
, enum pvec_type tag
)
997 struct Lisp_Vector
*v
= allocate_vectorlike (memlen
);
1000 /* Catch bogus values. */
1001 eassert (tag
<= PVEC_FONT
);
1002 eassert (memlen
- lisplen
<= (1 << PSEUDOVECTOR_REST_BITS
) - 1);
1003 eassert (lisplen
<= (1 << PSEUDOVECTOR_SIZE_BITS
) - 1);
1005 /* Only the first lisplen slots will be traced normally by the GC. */
1006 for (i
= 0; i
< lisplen
; ++i
)
1007 v
->contents
[i
] = Qnil
;
1009 XSETPVECTYPESIZE (v
, tag
, lisplen
, memlen
- lisplen
);
1014 allocate_buffer (void)
1016 struct buffer
*b
= xmalloc (sizeof *b
);
1018 SCM_NEWSMOB (b
->header
.self
, lisp_vectorlike_tag
, b
);
1019 BUFFER_PVEC_INIT (b
);
1020 /* Put B on the chain of all buffers including killed ones. */
1021 b
->next
= all_buffers
;
1023 /* Note that the rest fields of B are not initialized. */
1027 struct Lisp_Hash_Table
*
1028 allocate_hash_table (void)
1030 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table
, count
, PVEC_HASH_TABLE
);
1034 allocate_window (void)
1038 w
= ALLOCATE_PSEUDOVECTOR (struct window
, current_matrix
, PVEC_WINDOW
);
1039 /* Users assumes that non-Lisp data is zeroed. */
1040 memset (&w
->current_matrix
, 0,
1041 sizeof (*w
) - offsetof (struct window
, current_matrix
));
1046 allocate_terminal (void)
1050 t
= ALLOCATE_PSEUDOVECTOR (struct terminal
, next_terminal
, PVEC_TERMINAL
);
1051 /* Users assumes that non-Lisp data is zeroed. */
1052 memset (&t
->next_terminal
, 0,
1053 sizeof (*t
) - offsetof (struct terminal
, next_terminal
));
1058 allocate_frame (void)
1062 f
= ALLOCATE_PSEUDOVECTOR (struct frame
, face_cache
, PVEC_FRAME
);
1063 /* Users assumes that non-Lisp data is zeroed. */
1064 memset (&f
->face_cache
, 0,
1065 sizeof (*f
) - offsetof (struct frame
, face_cache
));
1069 struct Lisp_Process
*
1070 allocate_process (void)
1072 struct Lisp_Process
*p
;
1074 p
= ALLOCATE_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
1075 /* Users assumes that non-Lisp data is zeroed. */
1077 sizeof (*p
) - offsetof (struct Lisp_Process
, pid
));
1081 DEFUN ("make-vector", Fmake_vector
, Smake_vector
, 2, 2, 0,
1082 doc
: /* Return a newly created vector of length LENGTH, with each element being INIT.
1083 See also the function `vector'. */)
1084 (register Lisp_Object length
, Lisp_Object init
)
1087 register ptrdiff_t sizei
;
1088 register ptrdiff_t i
;
1089 register struct Lisp_Vector
*p
;
1091 CHECK_NATNUM (length
);
1093 p
= allocate_vector (XFASTINT (length
));
1094 sizei
= XFASTINT (length
);
1095 for (i
= 0; i
< sizei
; i
++)
1096 p
->contents
[i
] = init
;
1098 XSETVECTOR (vector
, p
);
1103 DEFUN ("vector", Fvector
, Svector
, 0, MANY
, 0,
1104 doc
: /* Return a newly created vector with specified arguments as elements.
1105 Any number of arguments, even zero arguments, are allowed.
1106 usage: (vector &rest OBJECTS) */)
1107 (ptrdiff_t nargs
, Lisp_Object
*args
)
1110 register Lisp_Object val
= make_uninit_vector (nargs
);
1111 register struct Lisp_Vector
*p
= XVECTOR (val
);
1113 for (i
= 0; i
< nargs
; i
++)
1114 p
->contents
[i
] = args
[i
];
1119 make_byte_code (struct Lisp_Vector
*v
)
1121 /* Don't allow the global zero_vector to become a byte code object. */
1122 eassert (0 < v
->header
.size
);
1124 if (v
->header
.size
> 1 && STRINGP (v
->contents
[1])
1125 && STRING_MULTIBYTE (v
->contents
[1]))
1126 /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
1127 earlier because they produced a raw 8-bit string for byte-code
1128 and now such a byte-code string is loaded as multibyte while
1129 raw 8-bit characters converted to multibyte form. Thus, now we
1130 must convert them back to the original unibyte form. */
1131 v
->contents
[1] = Fstring_as_unibyte (v
->contents
[1]);
1132 XSETPVECTYPE (v
, PVEC_COMPILED
);
1135 DEFUN ("make-byte-code", Fmake_byte_code
, Smake_byte_code
, 4, MANY
, 0,
1136 doc
: /* Create a byte-code object with specified arguments as elements.
1137 The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
1138 vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
1139 and (optional) INTERACTIVE-SPEC.
1140 The first four arguments are required; at most six have any
1142 The ARGLIST can be either like the one of `lambda', in which case the arguments
1143 will be dynamically bound before executing the byte code, or it can be an
1144 integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
1145 minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
1146 of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
1147 argument to catch the left-over arguments. If such an integer is used, the
1148 arguments will not be dynamically bound but will be instead pushed on the
1149 stack before executing the byte-code.
1150 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
1151 (ptrdiff_t nargs
, Lisp_Object
*args
)
1154 register Lisp_Object val
= make_uninit_vector (nargs
);
1155 register struct Lisp_Vector
*p
= XVECTOR (val
);
1157 /* We used to purecopy everything here, if purify-flag was set. This worked
1158 OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
1159 dangerous, since make-byte-code is used during execution to build
1160 closures, so any closure built during the preload phase would end up
1161 copied into pure space, including its free variables, which is sometimes
1162 just wasteful and other times plainly wrong (e.g. those free vars may want
1165 for (i
= 0; i
< nargs
; i
++)
1166 p
->contents
[i
] = args
[i
];
1168 XSETCOMPILED (val
, p
);
1174 /***********************************************************************
1176 ***********************************************************************/
1179 set_symbol_name (Lisp_Object sym
, Lisp_Object name
)
1181 XSYMBOL (sym
)->name
= name
;
1184 DEFUN ("make-symbol", Fmake_symbol
, Smake_symbol
, 1, 1, 0,
1185 doc
: /* Return a newly allocated uninterned symbol whose name is NAME.
1186 Its value is void, and its function definition and property list are nil. */)
1189 register Lisp_Object val
;
1190 register struct Lisp_Symbol
*p
;
1192 CHECK_STRING (name
);
1194 p
= xmalloc (sizeof *p
);
1195 SCM_NEWSMOB (p
->self
, lisp_symbol_tag
, p
);
1196 XSETSYMBOL (val
, p
);
1198 set_symbol_name (val
, name
);
1199 set_symbol_plist (val
, Qnil
);
1200 p
->redirect
= SYMBOL_PLAINVAL
;
1201 SET_SYMBOL_VAL (p
, Qunbound
);
1202 set_symbol_function (val
, Qnil
);
1203 set_symbol_next (val
, NULL
);
1204 p
->interned
= SYMBOL_UNINTERNED
;
1206 p
->declared_special
= false;
1213 /***********************************************************************
1214 Marker (Misc) Allocation
1215 ***********************************************************************/
1217 /* Return a newly allocated Lisp_Misc object of specified TYPE. */
1220 allocate_misc (enum Lisp_Misc_Type type
)
1225 p
= xmalloc (sizeof *p
);
1226 SCM_NEWSMOB (p
->u_any
.self
, lisp_misc_tag
, p
);
1228 XMISCANY (val
)->type
= type
;
1232 /* Free a Lisp_Misc object. */
1235 free_misc (Lisp_Object misc
)
1240 /* Verify properties of Lisp_Save_Value's representation
1241 that are assumed here and elsewhere. */
1243 verify (SAVE_UNUSED
== 0);
1244 verify (((SAVE_INTEGER
| SAVE_POINTER
| SAVE_FUNCPOINTER
| SAVE_OBJECT
)
1248 /* Return Lisp_Save_Value objects for the various combinations
1249 that callers need. */
1252 make_save_int_int_int (ptrdiff_t a
, ptrdiff_t b
, ptrdiff_t c
)
1254 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1255 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1256 p
->save_type
= SAVE_TYPE_INT_INT_INT
;
1257 p
->data
[0].integer
= a
;
1258 p
->data
[1].integer
= b
;
1259 p
->data
[2].integer
= c
;
1264 make_save_obj_obj_obj_obj (Lisp_Object a
, Lisp_Object b
, Lisp_Object c
,
1267 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1268 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1269 p
->save_type
= SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
;
1270 p
->data
[0].object
= a
;
1271 p
->data
[1].object
= b
;
1272 p
->data
[2].object
= c
;
1273 p
->data
[3].object
= d
;
1278 make_save_ptr (void *a
)
1280 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1281 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1282 p
->save_type
= SAVE_POINTER
;
1283 p
->data
[0].pointer
= a
;
1288 make_save_ptr_int (void *a
, ptrdiff_t b
)
1290 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1291 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1292 p
->save_type
= SAVE_TYPE_PTR_INT
;
1293 p
->data
[0].pointer
= a
;
1294 p
->data
[1].integer
= b
;
1298 #if ! (defined USE_X_TOOLKIT || defined USE_GTK)
1300 make_save_ptr_ptr (void *a
, void *b
)
1302 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1303 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1304 p
->save_type
= SAVE_TYPE_PTR_PTR
;
1305 p
->data
[0].pointer
= a
;
1306 p
->data
[1].pointer
= b
;
1312 make_save_funcptr_ptr_obj (void (*a
) (void), void *b
, Lisp_Object c
)
1314 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1315 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1316 p
->save_type
= SAVE_TYPE_FUNCPTR_PTR_OBJ
;
1317 p
->data
[0].funcpointer
= a
;
1318 p
->data
[1].pointer
= b
;
1319 p
->data
[2].object
= c
;
1323 /* Return a Lisp_Save_Value object that represents an array A
1324 of N Lisp objects. */
1327 make_save_memory (Lisp_Object
*a
, ptrdiff_t n
)
1329 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1330 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1331 p
->save_type
= SAVE_TYPE_MEMORY
;
1332 p
->data
[0].pointer
= a
;
1333 p
->data
[1].integer
= n
;
1337 /* Free a Lisp_Save_Value object. Do not use this function
1338 if SAVE contains pointer other than returned by xmalloc. */
1341 free_save_value (Lisp_Object save
)
1343 xfree (XSAVE_POINTER (save
, 0));
1347 /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
1350 build_overlay (Lisp_Object start
, Lisp_Object end
, Lisp_Object plist
)
1352 register Lisp_Object overlay
;
1354 overlay
= allocate_misc (Lisp_Misc_Overlay
);
1355 OVERLAY_START (overlay
) = start
;
1356 OVERLAY_END (overlay
) = end
;
1357 set_overlay_plist (overlay
, plist
);
1358 XOVERLAY (overlay
)->next
= NULL
;
1362 DEFUN ("make-marker", Fmake_marker
, Smake_marker
, 0, 0, 0,
1363 doc
: /* Return a newly allocated marker which does not point at any place. */)
1366 register Lisp_Object val
;
1367 register struct Lisp_Marker
*p
;
1369 val
= allocate_misc (Lisp_Misc_Marker
);
1375 p
->insertion_type
= 0;
1376 p
->need_adjustment
= 0;
1380 /* Return a newly allocated marker which points into BUF
1381 at character position CHARPOS and byte position BYTEPOS. */
1384 build_marker (struct buffer
*buf
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
1387 struct Lisp_Marker
*m
;
1389 /* No dead buffers here. */
1390 eassert (BUFFER_LIVE_P (buf
));
1392 /* Every character is at least one byte. */
1393 eassert (charpos
<= bytepos
);
1395 obj
= allocate_misc (Lisp_Misc_Marker
);
1398 m
->charpos
= charpos
;
1399 m
->bytepos
= bytepos
;
1400 m
->insertion_type
= 0;
1401 m
->need_adjustment
= 0;
1402 m
->next
= BUF_MARKERS (buf
);
1403 BUF_MARKERS (buf
) = m
;
1407 /* Return a newly created vector or string with specified arguments as
1408 elements. If all the arguments are characters that can fit
1409 in a string of events, make a string; otherwise, make a vector.
1411 Any number of arguments, even zero arguments, are allowed. */
1414 make_event_array (ptrdiff_t nargs
, Lisp_Object
*args
)
1418 for (i
= 0; i
< nargs
; i
++)
1419 /* The things that fit in a string
1420 are characters that are in 0...127,
1421 after discarding the meta bit and all the bits above it. */
1422 if (!INTEGERP (args
[i
])
1423 || (XINT (args
[i
]) & ~(-CHAR_META
)) >= 0200)
1424 return Fvector (nargs
, args
);
1426 /* Since the loop exited, we know that all the things in it are
1427 characters, so we can make a string. */
1431 result
= Fmake_string (make_number (nargs
), make_number (0));
1432 for (i
= 0; i
< nargs
; i
++)
1434 SSET (result
, i
, XINT (args
[i
]));
1435 /* Move the meta bit to the right place for a string char. */
1436 if (XINT (args
[i
]) & CHAR_META
)
1437 SSET (result
, i
, SREF (result
, i
) | 0x80);
1446 /************************************************************************
1447 Memory Full Handling
1448 ************************************************************************/
1451 /* Called if xmalloc (NBYTES) returns zero. If NBYTES == SIZE_MAX,
1452 there may have been size_t overflow so that xmalloc was never
1453 called, or perhaps xmalloc was invoked successfully but the
1454 resulting pointer had problems fitting into a tagged EMACS_INT. In
1455 either case this counts as memory being full even though xmalloc
1459 memory_full (size_t nbytes
)
1461 /* Do not go into hysterics merely because a large request failed. */
1462 bool enough_free_memory
= 0;
1463 if (SPARE_MEMORY
< nbytes
)
1465 void *p
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1469 enough_free_memory
= 1;
1473 if (! enough_free_memory
)
1477 /* The first time we get here, free the spare memory. */
1480 xfree (spare_memory
);
1481 spare_memory
= NULL
;
1485 /* This used to call error, but if we've run out of memory, we could
1486 get infinite recursion trying to build the string. */
1487 xsignal (Qnil
, Vmemory_signal_data
);
1490 /* If we released our reserve (due to running out of memory),
1491 and we have a fair amount free once again,
1492 try to set aside another reserve in case we run out once more.
1494 This is called when a relocatable block is freed in ralloc.c,
1495 and also directly from this file, in case we're not using ralloc.c. */
1498 refill_memory_reserve (void)
1500 if (spare_memory
== NULL
)
1501 spare_memory
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1504 Vmemory_full
= Qnil
;
1507 /* Determine whether it is safe to access memory at address P. */
1509 valid_pointer_p (void *p
)
1512 return w32_valid_pointer_p (p
, 16);
1516 /* Obviously, we cannot just access it (we would SEGV trying), so we
1517 trick the o/s to tell us whether p is a valid pointer.
1518 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
1519 not validate p in that case. */
1521 if (emacs_pipe (fd
) == 0)
1523 bool valid
= emacs_write (fd
[1], p
, 16) == 16;
1524 emacs_close (fd
[1]);
1525 emacs_close (fd
[0]);
1533 /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
1534 valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
1535 cannot validate OBJ. This function can be quite slow, so its primary
1536 use is the manual debugging. The only exception is print_object, where
1537 we use it to check whether the memory referenced by the pointer of
1538 Lisp_Save_Value object contains valid objects. */
1541 valid_lisp_object_p (Lisp_Object obj
)
1548 p
= (void *) SCM2PTR (obj
);
1550 if (p
== &buffer_defaults
|| p
== &buffer_local_symbols
)
1553 return valid_pointer_p (p
);
1556 /* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
1557 (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
1558 if not. Otherwise we can't rely on valid_lisp_object_p and return -1.
1559 This function is slow and should be used for debugging purposes. */
1562 relocatable_string_data_p (const char *str
)
1567 /***********************************************************************
1568 Pure Storage Compatibility Functions
1569 ***********************************************************************/
1572 check_pure_size (void)
1578 make_pure_string (const char *data
,
1579 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
1581 return make_specified_string (data
, nchars
, nbytes
, multibyte
);
1585 make_pure_c_string (const char *data
, ptrdiff_t nchars
)
1587 return build_string (data
);
1591 pure_cons (Lisp_Object car
, Lisp_Object cdr
)
1593 return Fcons (car
, cdr
);
1596 DEFUN ("purecopy", Fpurecopy
, Spurecopy
, 1, 1, 0,
1597 doc
: /* Return OBJ. */)
1598 (register Lisp_Object obj
)
1603 /***********************************************************************
1605 ***********************************************************************/
1608 staticpro (Lisp_Object
*varaddress
)
1613 DEFUN ("garbage-collect", Fgarbage_collect
, Sgarbage_collect
, 0, 0, "",
1614 doc
: /* Reclaim storage for Lisp objects no longer needed.
1615 Garbage collection happens automatically if you cons more than
1616 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
1617 `garbage-collect' normally returns a list with info on amount of space in use,
1618 where each entry has the form (NAME SIZE USED FREE), where:
1619 - NAME is a symbol describing the kind of objects this entry represents,
1620 - SIZE is the number of bytes used by each one,
1621 - USED is the number of those objects that were found live in the heap,
1622 - FREE is the number of those objects that are not live but that Emacs
1623 keeps around for future allocations (maybe because it does not know how
1624 to return them to the OS).
1625 However, if there was overflow in pure space, `garbage-collect'
1626 returns nil, because real GC can't be done.
1627 See Info node `(elisp)Garbage Collection'. */)
1634 #ifdef ENABLE_CHECKING
1636 bool suppress_checking
;
1639 die (const char *msg
, const char *file
, int line
)
1641 fprintf (stderr
, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
1643 terminate_due_to_signal (SIGABRT
, INT_MAX
);
1647 /* Initialization. */
1650 init_alloc_once (void)
1652 lisp_symbol_tag
= scm_make_smob_type ("elisp-symbol", 0);
1653 lisp_misc_tag
= scm_make_smob_type ("elisp-misc", 0);
1654 lisp_string_tag
= scm_make_smob_type ("elisp-string", 0);
1655 lisp_vectorlike_tag
= scm_make_smob_type ("elisp-vectorlike", 0);
1657 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
1662 refill_memory_reserve ();
1663 gc_cons_threshold
= GC_DEFAULT_THRESHOLD
;
1670 Vgc_elapsed
= make_float (0.0);
1674 valgrind_p
= RUNNING_ON_VALGRIND
!= 0;
1679 syms_of_alloc (void)
1683 DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold
,
1684 doc
: /* Number of bytes of consing between garbage collections.
1685 Garbage collection can happen automatically once this many bytes have been
1686 allocated since the last garbage collection. All data types count.
1688 Garbage collection happens automatically only when `eval' is called.
1690 By binding this temporarily to a large number, you can effectively
1691 prevent garbage collection during a part of the program.
1692 See also `gc-cons-percentage'. */);
1694 DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage
,
1695 doc
: /* Portion of the heap used for allocation.
1696 Garbage collection can happen automatically once this portion of the heap
1697 has been allocated since the last garbage collection.
1698 If this portion is smaller than `gc-cons-threshold', this is ignored. */);
1699 Vgc_cons_percentage
= make_float (0.1);
1701 DEFVAR_INT ("pure-bytes-used", pure_bytes_used
,
1702 doc
: /* Number of bytes of shareable Lisp data allocated so far. */);
1704 DEFVAR_LISP ("purify-flag", Vpurify_flag
,
1705 doc
: /* Non-nil means loading Lisp code in order to dump an executable.
1706 This means that certain objects should be allocated in shared (pure) space.
1707 It can also be set to a hash-table, in which case this table is used to
1708 do hash-consing of the objects allocated to pure space. */);
1710 DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages
,
1711 doc
: /* Non-nil means display messages at start and end of garbage collection. */);
1712 garbage_collection_messages
= 0;
1714 DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook
,
1715 doc
: /* Hook run after garbage collection has finished. */);
1716 Vpost_gc_hook
= Qnil
;
1717 DEFSYM (Qpost_gc_hook
, "post-gc-hook");
1719 DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data
,
1720 doc
: /* Precomputed `signal' argument for memory-full error. */);
1721 /* We build this in advance because if we wait until we need it, we might
1722 not be able to allocate the memory to hold it. */
1724 = listn (CONSTYPE_PURE
, 2, Qerror
,
1725 build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
1727 DEFVAR_LISP ("memory-full", Vmemory_full
,
1728 doc
: /* Non-nil means Emacs cannot get much more Lisp memory. */);
1729 Vmemory_full
= Qnil
;
1731 DEFSYM (Qgc_cons_threshold
, "gc-cons-threshold");
1732 DEFSYM (Qchar_table_extra_slots
, "char-table-extra-slots");
1734 DEFVAR_LISP ("gc-elapsed", Vgc_elapsed
,
1735 doc
: /* Accumulated time elapsed in garbage collections.
1736 The time is in seconds as a floating point value. */);
1737 DEFVAR_INT ("gcs-done", gcs_done
,
1738 doc
: /* Accumulated number of garbage collections done. */);
1741 /* When compiled with GCC, GDB might say "No enum type named
1742 pvec_type" if we don't have at least one symbol with that type, and
1743 then xbacktrace could fail. Similarly for the other enums and
1744 their values. Some non-GCC compilers don't like these constructs. */
1748 enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS
;
1749 enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS
;
1750 enum char_bits char_bits
;
1751 enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE
;
1752 enum Lisp_Bits Lisp_Bits
;
1753 enum Lisp_Compiled Lisp_Compiled
;
1754 enum maxargs maxargs
;
1755 enum MAX_ALLOCA MAX_ALLOCA
;
1756 enum More_Lisp_Bits More_Lisp_Bits
;
1757 enum pvec_type pvec_type
;
1758 } const EXTERNALLY_VISIBLE gdb_make_enums_visible
= {0};
1759 #endif /* __GNUC__ */