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
;
147 XFLOAT_INIT (Lisp_Object f
, double n
)
149 XFLOAT (f
)->data
= n
;
153 /************************************************************************
155 ************************************************************************/
157 /* Function malloc calls this if it finds we are near exhausting storage. */
160 malloc_warning (const char *str
)
162 pending_malloc_warning
= str
;
166 /* Display an already-pending malloc warning. */
169 display_malloc_warning (void)
171 call3 (intern ("display-warning"),
173 build_string (pending_malloc_warning
),
174 intern ("emergency"));
175 pending_malloc_warning
= 0;
178 /* Called if we can't allocate relocatable space for a buffer. */
181 buffer_memory_full (ptrdiff_t nbytes
)
183 /* If buffers use the relocating allocator, no need to free
184 spare_memory, because we may have plenty of malloc space left
185 that we could get, and if we don't, the malloc that fails will
186 itself cause spare_memory to be freed. If buffers don't use the
187 relocating allocator, treat this like any other failing
191 memory_full (nbytes
);
193 /* This used to call error, but if we've run out of memory, we could
194 get infinite recursion trying to build the string. */
195 xsignal (Qnil
, Vmemory_signal_data
);
199 /* Like GC_MALLOC but check for no memory. */
202 xmalloc (size_t size
)
204 void *val
= GC_MALLOC (size
);
210 /* Like the above, but zeroes out the memory just allocated. */
213 xzalloc (size_t size
)
215 return xmalloc (size
);
218 /* Like GC_REALLOC but check for no memory. */
221 xrealloc (void *block
, size_t size
)
223 void *val
= GC_REALLOC (block
, size
);
235 /* Allocate pointerless memory. */
238 xmalloc_atomic (size_t size
)
240 void *val
= GC_MALLOC_ATOMIC (size
);
247 xzalloc_atomic (size_t size
)
249 return xmalloc_atomic (size
);
252 /* Allocate uncollectable memory. */
255 xmalloc_uncollectable (size_t size
)
257 void *val
= GC_MALLOC_UNCOLLECTABLE (size
);
263 /* Allocate memory, but if memory is exhausted, return NULL instead of
264 signalling an error. */
267 xmalloc_unsafe (size_t size
)
269 return GC_MALLOC (size
);
272 /* Allocate pointerless memory, but if memory is exhausted, return
273 NULL instead of signalling an error. */
276 xmalloc_atomic_unsafe (size_t size
)
278 return GC_MALLOC_ATOMIC (size
);
281 /* Other parts of Emacs pass large int values to allocator functions
282 expecting ptrdiff_t. This is portable in practice, but check it to
284 verify (INT_MAX
<= PTRDIFF_MAX
);
287 /* Allocate an array of NITEMS items, each of size ITEM_SIZE.
288 Signal an error on memory exhaustion. */
291 xnmalloc (ptrdiff_t nitems
, ptrdiff_t item_size
)
293 eassert (0 <= nitems
&& 0 < item_size
);
294 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
295 memory_full (SIZE_MAX
);
296 return xmalloc (nitems
* item_size
);
299 /* Like xnmalloc for pointerless objects. */
302 xnmalloc_atomic (ptrdiff_t nitems
, ptrdiff_t item_size
)
304 eassert (0 <= nitems
&& 0 < item_size
);
305 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
306 memory_full (SIZE_MAX
);
307 return xmalloc_atomic (nitems
* item_size
);
310 /* Reallocate an array PA to make it of NITEMS items, each of size ITEM_SIZE.
311 Signal an error on memory exhaustion. */
314 xnrealloc (void *pa
, ptrdiff_t nitems
, ptrdiff_t item_size
)
316 eassert (0 <= nitems
&& 0 < item_size
);
317 if (min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
< nitems
)
318 memory_full (SIZE_MAX
);
319 return xrealloc (pa
, nitems
* item_size
);
323 /* Grow PA, which points to an array of *NITEMS items, and return the
324 location of the reallocated array, updating *NITEMS to reflect its
325 new size. The new array will contain at least NITEMS_INCR_MIN more
326 items, but will not contain more than NITEMS_MAX items total.
327 ITEM_SIZE is the size of each item, in bytes.
329 ITEM_SIZE and NITEMS_INCR_MIN must be positive. *NITEMS must be
330 nonnegative. If NITEMS_MAX is -1, it is treated as if it were
333 If PA is null, then allocate a new array instead of reallocating
336 If memory exhaustion occurs, set *NITEMS to zero if PA is null, and
337 signal an error (i.e., do not return).
339 Thus, to grow an array A without saving its old contents, do
340 { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }.
341 The A = NULL avoids a dangling pointer if xpalloc exhausts memory
342 and signals an error, and later this code is reexecuted and
343 attempts to free A. */
346 xpalloc (void *pa
, ptrdiff_t *nitems
, ptrdiff_t nitems_incr_min
,
347 ptrdiff_t nitems_max
, ptrdiff_t item_size
)
349 /* The approximate size to use for initial small allocation
350 requests. This is the largest "small" request for the GNU C
352 enum { DEFAULT_MXFAST
= 64 * sizeof (size_t) / 4 };
354 /* If the array is tiny, grow it to about (but no greater than)
355 DEFAULT_MXFAST bytes. Otherwise, grow it by about 50%. */
356 ptrdiff_t n
= *nitems
;
357 ptrdiff_t tiny_max
= DEFAULT_MXFAST
/ item_size
- n
;
358 ptrdiff_t half_again
= n
>> 1;
359 ptrdiff_t incr_estimate
= max (tiny_max
, half_again
);
361 /* Adjust the increment according to three constraints: NITEMS_INCR_MIN,
362 NITEMS_MAX, and what the C language can represent safely. */
363 ptrdiff_t C_language_max
= min (PTRDIFF_MAX
, SIZE_MAX
) / item_size
;
364 ptrdiff_t n_max
= (0 <= nitems_max
&& nitems_max
< C_language_max
365 ? nitems_max
: C_language_max
);
366 ptrdiff_t nitems_incr_max
= n_max
- n
;
367 ptrdiff_t incr
= max (nitems_incr_min
, min (incr_estimate
, nitems_incr_max
));
369 eassert (0 < item_size
&& 0 < nitems_incr_min
&& 0 <= n
&& -1 <= nitems_max
);
372 if (nitems_incr_max
< incr
)
373 memory_full (SIZE_MAX
);
375 pa
= xrealloc (pa
, n
* item_size
);
381 /* Like strdup, but uses xmalloc. */
384 xstrdup (const char *s
)
388 size
= strlen (s
) + 1;
389 return memcpy (xmalloc_atomic (size
), s
, size
);
392 /* Like above, but duplicates Lisp string to C string. */
395 xlispstrdup (Lisp_Object string
)
397 ptrdiff_t size
= SBYTES (string
) + 1;
398 return memcpy (xmalloc_atomic (size
), SSDATA (string
), size
);
401 /* Assign to *PTR a copy of STRING, freeing any storage *PTR formerly
402 pointed to. If STRING is null, assign it without copying anything.
403 Allocate before freeing, to avoid a dangling pointer if allocation
407 dupstring (char **ptr
, char const *string
)
410 *ptr
= string
? xstrdup (string
) : 0;
415 /* Like putenv, but (1) use the equivalent of xmalloc and (2) the
416 argument is a const pointer. */
419 xputenv (char const *string
)
421 if (putenv ((char *) string
) != 0)
425 /* Return a newly allocated memory block of SIZE bytes, remembering
426 to free it when unwinding. */
428 record_xmalloc (size_t size
)
430 void *p
= xmalloc (size
);
431 record_unwind_protect_ptr (xfree
, p
);
435 /***********************************************************************
437 ***********************************************************************/
439 /* Return a new interval. */
444 INTERVAL val
= xmalloc (sizeof (struct interval
));
445 RESET_INTERVAL (val
);
449 /***********************************************************************
451 ***********************************************************************/
453 /* Initialize string allocation. Called from init_alloc_once. */
458 empty_unibyte_string
= make_empty_string (0);
459 empty_multibyte_string
= make_empty_string (1);
462 /* Return a new Lisp_String. */
464 static struct Lisp_String
*
465 allocate_string (void)
467 return xmalloc (sizeof (struct Lisp_String
));
471 /* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes,
472 plus a NUL byte at the end. Allocate an sdata structure for S, and
473 set S->data to its `u.data' member. Store a NUL byte at the end of
474 S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free
475 S->data if it was initially non-null. */
478 allocate_string_data (struct Lisp_String
*s
,
479 EMACS_INT nchars
, EMACS_INT nbytes
)
483 if (STRING_BYTES_BOUND
< nbytes
)
486 data
= GC_MALLOC_ATOMIC (nbytes
+ 1);
489 s
->size_byte
= nbytes
;
490 s
->data
[nbytes
] = '\0';
494 string_overflow (void)
496 error ("Maximum string size exceeded");
500 make_empty_string (int multibyte
)
503 struct Lisp_String
*s
;
505 s
= allocate_string ();
506 allocate_string_data (s
, 0, 0);
507 XSETSTRING (string
, s
);
509 STRING_SET_UNIBYTE (string
);
514 DEFUN ("make-string", Fmake_string
, Smake_string
, 2, 2, 0,
515 doc
: /* Return a newly created string of length LENGTH, with INIT in each element.
516 LENGTH must be an integer.
517 INIT must be an integer that represents a character. */)
518 (Lisp_Object length
, Lisp_Object init
)
520 register Lisp_Object val
;
524 CHECK_NATNUM (length
);
525 CHECK_CHARACTER (init
);
528 if (ASCII_CHAR_P (c
))
530 nbytes
= XINT (length
);
531 val
= make_uninit_string (nbytes
);
532 memset (SDATA (val
), c
, nbytes
);
533 SDATA (val
)[nbytes
] = 0;
537 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
538 ptrdiff_t len
= CHAR_STRING (c
, str
);
539 EMACS_INT string_len
= XINT (length
);
540 unsigned char *p
, *beg
, *end
;
542 if (string_len
> STRING_BYTES_BOUND
/ len
)
544 nbytes
= len
* string_len
;
545 val
= make_uninit_multibyte_string (string_len
, nbytes
);
546 for (beg
= SDATA (val
), p
= beg
, end
= beg
+ nbytes
; p
< end
; p
+= len
)
548 /* First time we just copy `str' to the data of `val'. */
550 memcpy (p
, str
, len
);
553 /* Next time we copy largest possible chunk from
554 initialized to uninitialized part of `val'. */
555 len
= min (p
- beg
, end
- p
);
556 memcpy (p
, beg
, len
);
565 /* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
569 bool_vector_fill (Lisp_Object a
, Lisp_Object init
)
571 EMACS_INT nbits
= bool_vector_size (a
);
574 unsigned char *data
= bool_vector_uchar_data (a
);
575 int pattern
= NILP (init
) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR
) - 1;
576 ptrdiff_t nbytes
= bool_vector_bytes (nbits
);
577 int last_mask
= ~ (~0u << ((nbits
- 1) % BOOL_VECTOR_BITS_PER_CHAR
+ 1));
578 memset (data
, pattern
, nbytes
- 1);
579 data
[nbytes
- 1] = pattern
& last_mask
;
584 /* Return a newly allocated, uninitialized bool vector of size NBITS. */
587 make_uninit_bool_vector (EMACS_INT nbits
)
590 EMACS_INT words
= bool_vector_words (nbits
);
591 EMACS_INT word_bytes
= words
* sizeof (bits_word
);
592 EMACS_INT needed_elements
= ((bool_header_size
- header_size
+ word_bytes
595 struct Lisp_Bool_Vector
*p
596 = (struct Lisp_Bool_Vector
*) allocate_vector (needed_elements
);
598 XSETPVECTYPESIZE (XVECTOR (val
), PVEC_BOOL_VECTOR
, 0, 0);
601 /* Clear padding at the end. */
603 p
->data
[words
- 1] = 0;
608 DEFUN ("make-bool-vector", Fmake_bool_vector
, Smake_bool_vector
, 2, 2, 0,
609 doc
: /* Return a new bool-vector of length LENGTH, using INIT for each element.
610 LENGTH must be a number. INIT matters only in whether it is t or nil. */)
611 (Lisp_Object length
, Lisp_Object init
)
615 CHECK_NATNUM (length
);
616 val
= make_uninit_bool_vector (XFASTINT (length
));
617 return bool_vector_fill (val
, init
);
620 DEFUN ("bool-vector", Fbool_vector
, Sbool_vector
, 0, MANY
, 0,
621 doc
: /* Return a new bool-vector with specified arguments as elements.
622 Any number of arguments, even zero arguments, are allowed.
623 usage: (bool-vector &rest OBJECTS) */)
624 (ptrdiff_t nargs
, Lisp_Object
*args
)
629 vector
= make_uninit_bool_vector (nargs
);
630 for (i
= 0; i
< nargs
; i
++)
631 bool_vector_set (vector
, i
, !NILP (args
[i
]));
636 /* Make a string from NBYTES bytes at CONTENTS, and compute the number
637 of characters from the contents. This string may be unibyte or
638 multibyte, depending on the contents. */
641 make_string (const char *contents
, ptrdiff_t nbytes
)
643 register Lisp_Object val
;
644 ptrdiff_t nchars
, multibyte_nbytes
;
646 parse_str_as_multibyte ((const unsigned char *) contents
, nbytes
,
647 &nchars
, &multibyte_nbytes
);
648 if (nbytes
== nchars
|| nbytes
!= multibyte_nbytes
)
649 /* CONTENTS contains no multibyte sequences or contains an invalid
650 multibyte sequence. We must make unibyte string. */
651 val
= make_unibyte_string (contents
, nbytes
);
653 val
= make_multibyte_string (contents
, nchars
, nbytes
);
658 /* Make an unibyte string from LENGTH bytes at CONTENTS. */
661 make_unibyte_string (const char *contents
, ptrdiff_t length
)
663 register Lisp_Object val
;
664 val
= make_uninit_string (length
);
665 memcpy (SDATA (val
), contents
, length
);
670 /* Make a multibyte string from NCHARS characters occupying NBYTES
671 bytes at CONTENTS. */
674 make_multibyte_string (const char *contents
,
675 ptrdiff_t nchars
, ptrdiff_t nbytes
)
677 register Lisp_Object val
;
678 val
= make_uninit_multibyte_string (nchars
, nbytes
);
679 memcpy (SDATA (val
), contents
, nbytes
);
684 /* Make a string from NCHARS characters occupying NBYTES bytes at
685 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
688 make_string_from_bytes (const char *contents
,
689 ptrdiff_t nchars
, ptrdiff_t nbytes
)
691 register Lisp_Object val
;
692 val
= make_uninit_multibyte_string (nchars
, nbytes
);
693 memcpy (SDATA (val
), contents
, nbytes
);
694 if (SBYTES (val
) == SCHARS (val
))
695 STRING_SET_UNIBYTE (val
);
700 /* Make a string from NCHARS characters occupying NBYTES bytes at
701 CONTENTS. The argument MULTIBYTE controls whether to label the
702 string as multibyte. If NCHARS is negative, it counts the number of
703 characters by itself. */
706 make_specified_string (const char *contents
,
707 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
714 nchars
= multibyte_chars_in_text ((const unsigned char *) contents
,
719 val
= make_uninit_multibyte_string (nchars
, nbytes
);
720 memcpy (SDATA (val
), contents
, nbytes
);
722 STRING_SET_UNIBYTE (val
);
727 /* Return an unibyte Lisp_String set up to hold LENGTH characters
728 occupying LENGTH bytes. */
731 make_uninit_string (EMACS_INT length
)
736 return empty_unibyte_string
;
737 val
= make_uninit_multibyte_string (length
, length
);
738 STRING_SET_UNIBYTE (val
);
743 /* Return a multibyte Lisp_String set up to hold NCHARS characters
744 which occupy NBYTES bytes. */
747 make_uninit_multibyte_string (EMACS_INT nchars
, EMACS_INT nbytes
)
750 struct Lisp_String
*s
;
755 return empty_multibyte_string
;
757 s
= allocate_string ();
759 allocate_string_data (s
, nchars
, nbytes
);
760 XSETSTRING (string
, s
);
764 /* Print arguments to BUF according to a FORMAT, then return
765 a Lisp_String initialized with the data from BUF. */
768 make_formatted_string (char *buf
, const char *format
, ...)
773 va_start (ap
, format
);
774 length
= vsprintf (buf
, format
, ap
);
776 return make_string (buf
, length
);
780 /***********************************************************************
782 ***********************************************************************/
784 /* Return a new float object with value FLOAT_VALUE. */
787 make_float (double float_value
)
789 register Lisp_Object val
;
790 XSETFLOAT (val
, xmalloc_atomic (sizeof (struct Lisp_Float
)));
791 XFLOAT_INIT (val
, float_value
);
797 /***********************************************************************
799 ***********************************************************************/
801 DEFUN ("cons", Fcons
, Scons
, 2, 2, 0,
802 doc
: /* Create a new cons, give it CAR and CDR as components, and return it. */)
803 (Lisp_Object car
, Lisp_Object cdr
)
805 register Lisp_Object val
;
807 XSETCONS (val
, xmalloc (sizeof (struct Lisp_Cons
)));
813 /* Make a list of 1, 2, 3, 4 or 5 specified objects. */
816 list1 (Lisp_Object arg1
)
818 return Fcons (arg1
, Qnil
);
822 list2 (Lisp_Object arg1
, Lisp_Object arg2
)
824 return Fcons (arg1
, Fcons (arg2
, Qnil
));
829 list3 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
831 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Qnil
)));
836 list4 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
)
838 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
, Qnil
))));
843 list5 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
, Lisp_Object arg5
)
845 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
,
846 Fcons (arg5
, Qnil
)))));
849 /* Make a list of COUNT Lisp_Objects, where ARG is the
850 first one. Allocate conses from pure space if TYPE
851 is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
854 listn (enum constype type
, ptrdiff_t count
, Lisp_Object arg
, ...)
858 Lisp_Object val
, *objp
;
860 /* Change to SAFE_ALLOCA if you hit this eassert. */
861 eassert (count
<= MAX_ALLOCA
/ word_size
);
863 objp
= alloca (count
* word_size
);
866 for (i
= 1; i
< count
; i
++)
867 objp
[i
] = va_arg (ap
, Lisp_Object
);
870 for (val
= Qnil
, i
= count
- 1; i
>= 0; i
--)
872 if (type
== CONSTYPE_PURE
)
873 val
= pure_cons (objp
[i
], val
);
874 else if (type
== CONSTYPE_HEAP
)
875 val
= Fcons (objp
[i
], val
);
882 DEFUN ("list", Flist
, Slist
, 0, MANY
, 0,
883 doc
: /* Return a newly created list with specified arguments as elements.
884 Any number of arguments, even zero arguments, are allowed.
885 usage: (list &rest OBJECTS) */)
886 (ptrdiff_t nargs
, Lisp_Object
*args
)
888 register Lisp_Object val
;
894 val
= Fcons (args
[nargs
], val
);
900 DEFUN ("make-list", Fmake_list
, Smake_list
, 2, 2, 0,
901 doc
: /* Return a newly created list of length LENGTH, with each element being INIT. */)
902 (register Lisp_Object length
, Lisp_Object init
)
904 register Lisp_Object val
;
905 register EMACS_INT size
;
907 CHECK_NATNUM (length
);
908 size
= XFASTINT (length
);
913 val
= Fcons (init
, val
);
918 val
= Fcons (init
, val
);
923 val
= Fcons (init
, val
);
928 val
= Fcons (init
, val
);
933 val
= Fcons (init
, val
);
948 /***********************************************************************
950 ***********************************************************************/
952 /* The only vector with 0 slots, allocated from pure space. */
954 Lisp_Object zero_vector
;
956 /* Called once to initialize vector allocation. */
961 XSETVECTOR (zero_vector
, xmalloc (header_size
));
962 XVECTOR (zero_vector
)->header
.size
= 0;
965 /* Value is a pointer to a newly allocated Lisp_Vector structure
966 with room for LEN Lisp_Objects. */
968 static struct Lisp_Vector
*
969 allocate_vectorlike (ptrdiff_t len
)
972 return XVECTOR (zero_vector
);
974 return xmalloc (header_size
+ len
* word_size
);
978 /* Allocate a vector with LEN slots. */
981 allocate_vector (EMACS_INT len
)
983 struct Lisp_Vector
*v
;
984 ptrdiff_t nbytes_max
= min (PTRDIFF_MAX
, SIZE_MAX
);
986 if (min ((nbytes_max
- header_size
) / word_size
, MOST_POSITIVE_FIXNUM
) < len
)
987 memory_full (SIZE_MAX
);
988 v
= allocate_vectorlike (len
);
989 v
->header
.size
= len
;
994 /* Allocate other vector-like structures. */
997 allocate_pseudovector (int memlen
, int lisplen
, enum pvec_type tag
)
999 struct Lisp_Vector
*v
= allocate_vectorlike (memlen
);
1002 /* Catch bogus values. */
1003 eassert (tag
<= PVEC_FONT
);
1004 eassert (memlen
- lisplen
<= (1 << PSEUDOVECTOR_REST_BITS
) - 1);
1005 eassert (lisplen
<= (1 << PSEUDOVECTOR_SIZE_BITS
) - 1);
1007 /* Only the first lisplen slots will be traced normally by the GC. */
1008 for (i
= 0; i
< lisplen
; ++i
)
1009 v
->contents
[i
] = Qnil
;
1011 XSETPVECTYPESIZE (v
, tag
, lisplen
, memlen
- lisplen
);
1016 allocate_buffer (void)
1018 struct buffer
*b
= xmalloc (sizeof *b
);
1020 BUFFER_PVEC_INIT (b
);
1021 /* Put B on the chain of all buffers including killed ones. */
1022 b
->next
= all_buffers
;
1024 /* Note that the rest fields of B are not initialized. */
1028 struct Lisp_Hash_Table
*
1029 allocate_hash_table (void)
1031 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table
, count
, PVEC_HASH_TABLE
);
1035 allocate_window (void)
1039 w
= ALLOCATE_PSEUDOVECTOR (struct window
, current_matrix
, PVEC_WINDOW
);
1040 /* Users assumes that non-Lisp data is zeroed. */
1041 memset (&w
->current_matrix
, 0,
1042 sizeof (*w
) - offsetof (struct window
, current_matrix
));
1047 allocate_terminal (void)
1051 t
= ALLOCATE_PSEUDOVECTOR (struct terminal
, next_terminal
, PVEC_TERMINAL
);
1052 /* Users assumes that non-Lisp data is zeroed. */
1053 memset (&t
->next_terminal
, 0,
1054 sizeof (*t
) - offsetof (struct terminal
, next_terminal
));
1059 allocate_frame (void)
1063 f
= ALLOCATE_PSEUDOVECTOR (struct frame
, face_cache
, PVEC_FRAME
);
1064 /* Users assumes that non-Lisp data is zeroed. */
1065 memset (&f
->face_cache
, 0,
1066 sizeof (*f
) - offsetof (struct frame
, face_cache
));
1070 struct Lisp_Process
*
1071 allocate_process (void)
1073 struct Lisp_Process
*p
;
1075 p
= ALLOCATE_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
1076 /* Users assumes that non-Lisp data is zeroed. */
1078 sizeof (*p
) - offsetof (struct Lisp_Process
, pid
));
1082 DEFUN ("make-vector", Fmake_vector
, Smake_vector
, 2, 2, 0,
1083 doc
: /* Return a newly created vector of length LENGTH, with each element being INIT.
1084 See also the function `vector'. */)
1085 (register Lisp_Object length
, Lisp_Object init
)
1088 register ptrdiff_t sizei
;
1089 register ptrdiff_t i
;
1090 register struct Lisp_Vector
*p
;
1092 CHECK_NATNUM (length
);
1094 p
= allocate_vector (XFASTINT (length
));
1095 sizei
= XFASTINT (length
);
1096 for (i
= 0; i
< sizei
; i
++)
1097 p
->contents
[i
] = init
;
1099 XSETVECTOR (vector
, p
);
1104 DEFUN ("vector", Fvector
, Svector
, 0, MANY
, 0,
1105 doc
: /* Return a newly created vector with specified arguments as elements.
1106 Any number of arguments, even zero arguments, are allowed.
1107 usage: (vector &rest OBJECTS) */)
1108 (ptrdiff_t nargs
, Lisp_Object
*args
)
1111 register Lisp_Object val
= make_uninit_vector (nargs
);
1112 register struct Lisp_Vector
*p
= XVECTOR (val
);
1114 for (i
= 0; i
< nargs
; i
++)
1115 p
->contents
[i
] = args
[i
];
1120 make_byte_code (struct Lisp_Vector
*v
)
1122 /* Don't allow the global zero_vector to become a byte code object. */
1123 eassert (0 < v
->header
.size
);
1125 if (v
->header
.size
> 1 && STRINGP (v
->contents
[1])
1126 && STRING_MULTIBYTE (v
->contents
[1]))
1127 /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
1128 earlier because they produced a raw 8-bit string for byte-code
1129 and now such a byte-code string is loaded as multibyte while
1130 raw 8-bit characters converted to multibyte form. Thus, now we
1131 must convert them back to the original unibyte form. */
1132 v
->contents
[1] = Fstring_as_unibyte (v
->contents
[1]);
1133 XSETPVECTYPE (v
, PVEC_COMPILED
);
1136 DEFUN ("make-byte-code", Fmake_byte_code
, Smake_byte_code
, 4, MANY
, 0,
1137 doc
: /* Create a byte-code object with specified arguments as elements.
1138 The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
1139 vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
1140 and (optional) INTERACTIVE-SPEC.
1141 The first four arguments are required; at most six have any
1143 The ARGLIST can be either like the one of `lambda', in which case the arguments
1144 will be dynamically bound before executing the byte code, or it can be an
1145 integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
1146 minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
1147 of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
1148 argument to catch the left-over arguments. If such an integer is used, the
1149 arguments will not be dynamically bound but will be instead pushed on the
1150 stack before executing the byte-code.
1151 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
1152 (ptrdiff_t nargs
, Lisp_Object
*args
)
1155 register Lisp_Object val
= make_uninit_vector (nargs
);
1156 register struct Lisp_Vector
*p
= XVECTOR (val
);
1158 /* We used to purecopy everything here, if purify-flag was set. This worked
1159 OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
1160 dangerous, since make-byte-code is used during execution to build
1161 closures, so any closure built during the preload phase would end up
1162 copied into pure space, including its free variables, which is sometimes
1163 just wasteful and other times plainly wrong (e.g. those free vars may want
1166 for (i
= 0; i
< nargs
; i
++)
1167 p
->contents
[i
] = args
[i
];
1169 XSETCOMPILED (val
, p
);
1175 /***********************************************************************
1177 ***********************************************************************/
1180 set_symbol_name (Lisp_Object sym
, Lisp_Object name
)
1182 XSYMBOL (sym
)->name
= name
;
1185 DEFUN ("make-symbol", Fmake_symbol
, Smake_symbol
, 1, 1, 0,
1186 doc
: /* Return a newly allocated uninterned symbol whose name is NAME.
1187 Its value is void, and its function definition and property list are nil. */)
1190 register Lisp_Object val
;
1191 register struct Lisp_Symbol
*p
;
1193 CHECK_STRING (name
);
1195 XSETSYMBOL (val
, xmalloc (sizeof (struct Lisp_Symbol
)));
1197 set_symbol_name (val
, name
);
1198 set_symbol_plist (val
, Qnil
);
1199 p
->redirect
= SYMBOL_PLAINVAL
;
1200 SET_SYMBOL_VAL (p
, Qunbound
);
1201 set_symbol_function (val
, Qnil
);
1202 set_symbol_next (val
, NULL
);
1203 p
->gcmarkbit
= false;
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
)
1224 XSETMISC (val
, xmalloc (sizeof (union Lisp_Misc
)));
1225 XMISCANY (val
)->type
= type
;
1229 /* Free a Lisp_Misc object. */
1232 free_misc (Lisp_Object misc
)
1237 /* Verify properties of Lisp_Save_Value's representation
1238 that are assumed here and elsewhere. */
1240 verify (SAVE_UNUSED
== 0);
1241 verify (((SAVE_INTEGER
| SAVE_POINTER
| SAVE_FUNCPOINTER
| SAVE_OBJECT
)
1245 /* Return Lisp_Save_Value objects for the various combinations
1246 that callers need. */
1249 make_save_int_int_int (ptrdiff_t a
, ptrdiff_t b
, ptrdiff_t c
)
1251 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1252 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1253 p
->save_type
= SAVE_TYPE_INT_INT_INT
;
1254 p
->data
[0].integer
= a
;
1255 p
->data
[1].integer
= b
;
1256 p
->data
[2].integer
= c
;
1261 make_save_obj_obj_obj_obj (Lisp_Object a
, Lisp_Object b
, Lisp_Object c
,
1264 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1265 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1266 p
->save_type
= SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
;
1267 p
->data
[0].object
= a
;
1268 p
->data
[1].object
= b
;
1269 p
->data
[2].object
= c
;
1270 p
->data
[3].object
= d
;
1275 make_save_ptr (void *a
)
1277 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1278 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1279 p
->save_type
= SAVE_POINTER
;
1280 p
->data
[0].pointer
= a
;
1285 make_save_ptr_int (void *a
, ptrdiff_t b
)
1287 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1288 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1289 p
->save_type
= SAVE_TYPE_PTR_INT
;
1290 p
->data
[0].pointer
= a
;
1291 p
->data
[1].integer
= b
;
1295 #if ! (defined USE_X_TOOLKIT || defined USE_GTK)
1297 make_save_ptr_ptr (void *a
, void *b
)
1299 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1300 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1301 p
->save_type
= SAVE_TYPE_PTR_PTR
;
1302 p
->data
[0].pointer
= a
;
1303 p
->data
[1].pointer
= b
;
1309 make_save_funcptr_ptr_obj (void (*a
) (void), void *b
, Lisp_Object c
)
1311 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1312 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1313 p
->save_type
= SAVE_TYPE_FUNCPTR_PTR_OBJ
;
1314 p
->data
[0].funcpointer
= a
;
1315 p
->data
[1].pointer
= b
;
1316 p
->data
[2].object
= c
;
1320 /* Return a Lisp_Save_Value object that represents an array A
1321 of N Lisp objects. */
1324 make_save_memory (Lisp_Object
*a
, ptrdiff_t n
)
1326 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1327 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1328 p
->save_type
= SAVE_TYPE_MEMORY
;
1329 p
->data
[0].pointer
= a
;
1330 p
->data
[1].integer
= n
;
1334 /* Free a Lisp_Save_Value object. Do not use this function
1335 if SAVE contains pointer other than returned by xmalloc. */
1338 free_save_value (Lisp_Object save
)
1340 xfree (XSAVE_POINTER (save
, 0));
1344 /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
1347 build_overlay (Lisp_Object start
, Lisp_Object end
, Lisp_Object plist
)
1349 register Lisp_Object overlay
;
1351 overlay
= allocate_misc (Lisp_Misc_Overlay
);
1352 OVERLAY_START (overlay
) = start
;
1353 OVERLAY_END (overlay
) = end
;
1354 set_overlay_plist (overlay
, plist
);
1355 XOVERLAY (overlay
)->next
= NULL
;
1359 DEFUN ("make-marker", Fmake_marker
, Smake_marker
, 0, 0, 0,
1360 doc
: /* Return a newly allocated marker which does not point at any place. */)
1363 register Lisp_Object val
;
1364 register struct Lisp_Marker
*p
;
1366 val
= allocate_misc (Lisp_Misc_Marker
);
1372 p
->insertion_type
= 0;
1373 p
->need_adjustment
= 0;
1377 /* Return a newly allocated marker which points into BUF
1378 at character position CHARPOS and byte position BYTEPOS. */
1381 build_marker (struct buffer
*buf
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
1384 struct Lisp_Marker
*m
;
1386 /* No dead buffers here. */
1387 eassert (BUFFER_LIVE_P (buf
));
1389 /* Every character is at least one byte. */
1390 eassert (charpos
<= bytepos
);
1392 obj
= allocate_misc (Lisp_Misc_Marker
);
1395 m
->charpos
= charpos
;
1396 m
->bytepos
= bytepos
;
1397 m
->insertion_type
= 0;
1398 m
->need_adjustment
= 0;
1399 m
->next
= BUF_MARKERS (buf
);
1400 BUF_MARKERS (buf
) = m
;
1404 /* Return a newly created vector or string with specified arguments as
1405 elements. If all the arguments are characters that can fit
1406 in a string of events, make a string; otherwise, make a vector.
1408 Any number of arguments, even zero arguments, are allowed. */
1411 make_event_array (ptrdiff_t nargs
, Lisp_Object
*args
)
1415 for (i
= 0; i
< nargs
; i
++)
1416 /* The things that fit in a string
1417 are characters that are in 0...127,
1418 after discarding the meta bit and all the bits above it. */
1419 if (!INTEGERP (args
[i
])
1420 || (XINT (args
[i
]) & ~(-CHAR_META
)) >= 0200)
1421 return Fvector (nargs
, args
);
1423 /* Since the loop exited, we know that all the things in it are
1424 characters, so we can make a string. */
1428 result
= Fmake_string (make_number (nargs
), make_number (0));
1429 for (i
= 0; i
< nargs
; i
++)
1431 SSET (result
, i
, XINT (args
[i
]));
1432 /* Move the meta bit to the right place for a string char. */
1433 if (XINT (args
[i
]) & CHAR_META
)
1434 SSET (result
, i
, SREF (result
, i
) | 0x80);
1443 /************************************************************************
1444 Memory Full Handling
1445 ************************************************************************/
1448 /* Called if xmalloc (NBYTES) returns zero. If NBYTES == SIZE_MAX,
1449 there may have been size_t overflow so that xmalloc was never
1450 called, or perhaps xmalloc was invoked successfully but the
1451 resulting pointer had problems fitting into a tagged EMACS_INT. In
1452 either case this counts as memory being full even though xmalloc
1456 memory_full (size_t nbytes
)
1458 /* Do not go into hysterics merely because a large request failed. */
1459 bool enough_free_memory
= 0;
1460 if (SPARE_MEMORY
< nbytes
)
1462 void *p
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1466 enough_free_memory
= 1;
1470 if (! enough_free_memory
)
1474 /* The first time we get here, free the spare memory. */
1477 xfree (spare_memory
);
1478 spare_memory
= NULL
;
1482 /* This used to call error, but if we've run out of memory, we could
1483 get infinite recursion trying to build the string. */
1484 xsignal (Qnil
, Vmemory_signal_data
);
1487 /* If we released our reserve (due to running out of memory),
1488 and we have a fair amount free once again,
1489 try to set aside another reserve in case we run out once more.
1491 This is called when a relocatable block is freed in ralloc.c,
1492 and also directly from this file, in case we're not using ralloc.c. */
1495 refill_memory_reserve (void)
1497 if (spare_memory
== NULL
)
1498 spare_memory
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1501 Vmemory_full
= Qnil
;
1504 /* Determine whether it is safe to access memory at address P. */
1506 valid_pointer_p (void *p
)
1509 return w32_valid_pointer_p (p
, 16);
1513 /* Obviously, we cannot just access it (we would SEGV trying), so we
1514 trick the o/s to tell us whether p is a valid pointer.
1515 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
1516 not validate p in that case. */
1518 if (emacs_pipe (fd
) == 0)
1520 bool valid
= emacs_write (fd
[1], p
, 16) == 16;
1521 emacs_close (fd
[1]);
1522 emacs_close (fd
[0]);
1530 /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
1531 valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
1532 cannot validate OBJ. This function can be quite slow, so its primary
1533 use is the manual debugging. The only exception is print_object, where
1534 we use it to check whether the memory referenced by the pointer of
1535 Lisp_Save_Value object contains valid objects. */
1538 valid_lisp_object_p (Lisp_Object obj
)
1545 p
= (void *) XPNTR (obj
);
1547 if (p
== &buffer_defaults
|| p
== &buffer_local_symbols
)
1550 return valid_pointer_p (p
);
1553 /* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
1554 (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
1555 if not. Otherwise we can't rely on valid_lisp_object_p and return -1.
1556 This function is slow and should be used for debugging purposes. */
1559 relocatable_string_data_p (const char *str
)
1564 /***********************************************************************
1565 Pure Storage Compatibility Functions
1566 ***********************************************************************/
1569 check_pure_size (void)
1575 make_pure_string (const char *data
,
1576 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
1578 return make_specified_string (data
, nchars
, nbytes
, multibyte
);
1582 make_pure_c_string (const char *data
, ptrdiff_t nchars
)
1584 return build_string (data
);
1588 pure_cons (Lisp_Object car
, Lisp_Object cdr
)
1590 return Fcons (car
, cdr
);
1593 DEFUN ("purecopy", Fpurecopy
, Spurecopy
, 1, 1, 0,
1594 doc
: /* Return OBJ. */)
1595 (register Lisp_Object obj
)
1600 /***********************************************************************
1602 ***********************************************************************/
1605 staticpro (Lisp_Object
*varaddress
)
1610 DEFUN ("garbage-collect", Fgarbage_collect
, Sgarbage_collect
, 0, 0, "",
1611 doc
: /* Reclaim storage for Lisp objects no longer needed.
1612 Garbage collection happens automatically if you cons more than
1613 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
1614 `garbage-collect' normally returns a list with info on amount of space in use,
1615 where each entry has the form (NAME SIZE USED FREE), where:
1616 - NAME is a symbol describing the kind of objects this entry represents,
1617 - SIZE is the number of bytes used by each one,
1618 - USED is the number of those objects that were found live in the heap,
1619 - FREE is the number of those objects that are not live but that Emacs
1620 keeps around for future allocations (maybe because it does not know how
1621 to return them to the OS).
1622 However, if there was overflow in pure space, `garbage-collect'
1623 returns nil, because real GC can't be done.
1624 See Info node `(elisp)Garbage Collection'. */)
1631 #ifdef ENABLE_CHECKING
1633 bool suppress_checking
;
1636 die (const char *msg
, const char *file
, int line
)
1638 fprintf (stderr
, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
1640 terminate_due_to_signal (SIGABRT
, INT_MAX
);
1644 /* Initialization. */
1647 init_alloc_once (void)
1649 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
1654 refill_memory_reserve ();
1655 gc_cons_threshold
= GC_DEFAULT_THRESHOLD
;
1662 Vgc_elapsed
= make_float (0.0);
1666 valgrind_p
= RUNNING_ON_VALGRIND
!= 0;
1671 syms_of_alloc (void)
1673 DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold
,
1674 doc
: /* Number of bytes of consing between garbage collections.
1675 Garbage collection can happen automatically once this many bytes have been
1676 allocated since the last garbage collection. All data types count.
1678 Garbage collection happens automatically only when `eval' is called.
1680 By binding this temporarily to a large number, you can effectively
1681 prevent garbage collection during a part of the program.
1682 See also `gc-cons-percentage'. */);
1684 DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage
,
1685 doc
: /* Portion of the heap used for allocation.
1686 Garbage collection can happen automatically once this portion of the heap
1687 has been allocated since the last garbage collection.
1688 If this portion is smaller than `gc-cons-threshold', this is ignored. */);
1689 Vgc_cons_percentage
= make_float (0.1);
1691 DEFVAR_INT ("pure-bytes-used", pure_bytes_used
,
1692 doc
: /* Number of bytes of shareable Lisp data allocated so far. */);
1694 DEFVAR_LISP ("purify-flag", Vpurify_flag
,
1695 doc
: /* Non-nil means loading Lisp code in order to dump an executable.
1696 This means that certain objects should be allocated in shared (pure) space.
1697 It can also be set to a hash-table, in which case this table is used to
1698 do hash-consing of the objects allocated to pure space. */);
1700 DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages
,
1701 doc
: /* Non-nil means display messages at start and end of garbage collection. */);
1702 garbage_collection_messages
= 0;
1704 DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook
,
1705 doc
: /* Hook run after garbage collection has finished. */);
1706 Vpost_gc_hook
= Qnil
;
1707 DEFSYM (Qpost_gc_hook
, "post-gc-hook");
1709 DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data
,
1710 doc
: /* Precomputed `signal' argument for memory-full error. */);
1711 /* We build this in advance because if we wait until we need it, we might
1712 not be able to allocate the memory to hold it. */
1714 = listn (CONSTYPE_PURE
, 2, Qerror
,
1715 build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
1717 DEFVAR_LISP ("memory-full", Vmemory_full
,
1718 doc
: /* Non-nil means Emacs cannot get much more Lisp memory. */);
1719 Vmemory_full
= Qnil
;
1721 DEFSYM (Qgc_cons_threshold
, "gc-cons-threshold");
1722 DEFSYM (Qchar_table_extra_slots
, "char-table-extra-slots");
1724 DEFVAR_LISP ("gc-elapsed", Vgc_elapsed
,
1725 doc
: /* Accumulated time elapsed in garbage collections.
1726 The time is in seconds as a floating point value. */);
1727 DEFVAR_INT ("gcs-done", gcs_done
,
1728 doc
: /* Accumulated number of garbage collections done. */);
1733 defsubr (&Sbool_vector
);
1734 defsubr (&Smake_byte_code
);
1735 defsubr (&Smake_list
);
1736 defsubr (&Smake_vector
);
1737 defsubr (&Smake_string
);
1738 defsubr (&Smake_bool_vector
);
1739 defsubr (&Smake_symbol
);
1740 defsubr (&Smake_marker
);
1741 defsubr (&Spurecopy
);
1742 defsubr (&Sgarbage_collect
);
1745 /* When compiled with GCC, GDB might say "No enum type named
1746 pvec_type" if we don't have at least one symbol with that type, and
1747 then xbacktrace could fail. Similarly for the other enums and
1748 their values. Some non-GCC compilers don't like these constructs. */
1752 enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS
;
1753 enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS
;
1754 enum char_bits char_bits
;
1755 enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE
;
1756 enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE
;
1757 enum Lisp_Bits Lisp_Bits
;
1758 enum Lisp_Compiled Lisp_Compiled
;
1759 enum maxargs maxargs
;
1760 enum MAX_ALLOCA MAX_ALLOCA
;
1761 enum More_Lisp_Bits More_Lisp_Bits
;
1762 enum pvec_type pvec_type
;
1763 } const EXTERNALLY_VISIBLE gdb_make_enums_visible
= {0};
1764 #endif /* __GNUC__ */