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 /***********************************************************************
420 ***********************************************************************/
422 /* Return a new interval. */
427 INTERVAL val
= xmalloc (sizeof (struct interval
));
428 RESET_INTERVAL (val
);
432 /***********************************************************************
434 ***********************************************************************/
436 /* Initialize string allocation. Called from init_alloc_once. */
441 empty_unibyte_string
= make_empty_string (0);
442 empty_multibyte_string
= make_empty_string (1);
445 /* Return a new Lisp_String. */
448 allocate_string (void)
450 return scm_make_smob (lisp_string_tag
);
454 /* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes,
455 plus a NUL byte at the end. Allocate an sdata structure for S, and
456 set S->data to its `u.data' member. Store a NUL byte at the end of
457 S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free
458 S->data if it was initially non-null. */
461 allocate_string_data (Lisp_Object string
,
462 EMACS_INT nchars
, EMACS_INT nbytes
)
464 struct Lisp_String
*s
= (void *) SCM_SMOB_DATA (string
);
467 if (STRING_BYTES_BOUND
< nbytes
)
470 data
= GC_MALLOC_ATOMIC (nbytes
+ 1);
473 s
->size_byte
= nbytes
;
474 s
->data
[nbytes
] = '\0';
478 string_overflow (void)
480 error ("Maximum string size exceeded");
484 make_empty_string (int multibyte
)
488 string
= allocate_string ();
489 allocate_string_data (string
, 0, 0);
491 STRING_SET_UNIBYTE (string
);
496 DEFUN ("make-string", Fmake_string
, Smake_string
, 2, 2, 0,
497 doc
: /* Return a newly created string of length LENGTH, with INIT in each element.
498 LENGTH must be an integer.
499 INIT must be an integer that represents a character. */)
500 (Lisp_Object length
, Lisp_Object init
)
502 register Lisp_Object val
;
506 CHECK_NATNUM (length
);
507 CHECK_CHARACTER (init
);
510 if (ASCII_CHAR_P (c
))
512 nbytes
= XINT (length
);
513 val
= make_uninit_string (nbytes
);
514 memset (SDATA (val
), c
, nbytes
);
515 SDATA (val
)[nbytes
] = 0;
519 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
520 ptrdiff_t len
= CHAR_STRING (c
, str
);
521 EMACS_INT string_len
= XINT (length
);
522 unsigned char *p
, *beg
, *end
;
524 if (string_len
> STRING_BYTES_BOUND
/ len
)
526 nbytes
= len
* string_len
;
527 val
= make_uninit_multibyte_string (string_len
, nbytes
);
528 for (beg
= SDATA (val
), p
= beg
, end
= beg
+ nbytes
; p
< end
; p
+= len
)
530 /* First time we just copy `str' to the data of `val'. */
532 memcpy (p
, str
, len
);
535 /* Next time we copy largest possible chunk from
536 initialized to uninitialized part of `val'. */
537 len
= min (p
- beg
, end
- p
);
538 memcpy (p
, beg
, len
);
547 /* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
551 bool_vector_fill (Lisp_Object a
, Lisp_Object init
)
553 EMACS_INT nbits
= bool_vector_size (a
);
556 unsigned char *data
= bool_vector_uchar_data (a
);
557 int pattern
= NILP (init
) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR
) - 1;
558 ptrdiff_t nbytes
= bool_vector_bytes (nbits
);
559 int last_mask
= ~ (~0u << ((nbits
- 1) % BOOL_VECTOR_BITS_PER_CHAR
+ 1));
560 memset (data
, pattern
, nbytes
- 1);
561 data
[nbytes
- 1] = pattern
& last_mask
;
566 /* Return a newly allocated, uninitialized bool vector of size NBITS. */
569 make_uninit_bool_vector (EMACS_INT nbits
)
572 EMACS_INT words
= bool_vector_words (nbits
);
573 EMACS_INT word_bytes
= words
* sizeof (bits_word
);
574 EMACS_INT needed_elements
= ((bool_header_size
- header_size
+ word_bytes
577 struct Lisp_Bool_Vector
*p
578 = (struct Lisp_Bool_Vector
*) allocate_vector (needed_elements
);
580 XSETPVECTYPESIZE (XVECTOR (val
), PVEC_BOOL_VECTOR
, 0, 0);
583 /* Clear padding at the end. */
585 p
->data
[words
- 1] = 0;
590 DEFUN ("make-bool-vector", Fmake_bool_vector
, Smake_bool_vector
, 2, 2, 0,
591 doc
: /* Return a new bool-vector of length LENGTH, using INIT for each element.
592 LENGTH must be a number. INIT matters only in whether it is t or nil. */)
593 (Lisp_Object length
, Lisp_Object init
)
597 CHECK_NATNUM (length
);
598 val
= make_uninit_bool_vector (XFASTINT (length
));
599 return bool_vector_fill (val
, init
);
602 DEFUN ("bool-vector", Fbool_vector
, Sbool_vector
, 0, MANY
, 0,
603 doc
: /* Return a new bool-vector with specified arguments as elements.
604 Any number of arguments, even zero arguments, are allowed.
605 usage: (bool-vector &rest OBJECTS) */)
606 (ptrdiff_t nargs
, Lisp_Object
*args
)
611 vector
= make_uninit_bool_vector (nargs
);
612 for (i
= 0; i
< nargs
; i
++)
613 bool_vector_set (vector
, i
, !NILP (args
[i
]));
618 /* Make a string from NBYTES bytes at CONTENTS, and compute the number
619 of characters from the contents. This string may be unibyte or
620 multibyte, depending on the contents. */
623 make_string (const char *contents
, ptrdiff_t nbytes
)
625 register Lisp_Object val
;
626 ptrdiff_t nchars
, multibyte_nbytes
;
628 parse_str_as_multibyte ((const unsigned char *) contents
, nbytes
,
629 &nchars
, &multibyte_nbytes
);
630 if (nbytes
== nchars
|| nbytes
!= multibyte_nbytes
)
631 /* CONTENTS contains no multibyte sequences or contains an invalid
632 multibyte sequence. We must make unibyte string. */
633 val
= make_unibyte_string (contents
, nbytes
);
635 val
= make_multibyte_string (contents
, nchars
, nbytes
);
640 /* Make an unibyte string from LENGTH bytes at CONTENTS. */
643 make_unibyte_string (const char *contents
, ptrdiff_t length
)
645 register Lisp_Object val
;
646 val
= make_uninit_string (length
);
647 memcpy (SDATA (val
), contents
, length
);
652 /* Make a multibyte string from NCHARS characters occupying NBYTES
653 bytes at CONTENTS. */
656 make_multibyte_string (const char *contents
,
657 ptrdiff_t nchars
, ptrdiff_t nbytes
)
659 register Lisp_Object val
;
660 val
= make_uninit_multibyte_string (nchars
, nbytes
);
661 memcpy (SDATA (val
), contents
, nbytes
);
666 /* Make a string from NCHARS characters occupying NBYTES bytes at
667 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
670 make_string_from_bytes (const char *contents
,
671 ptrdiff_t nchars
, ptrdiff_t nbytes
)
673 register Lisp_Object val
;
674 val
= make_uninit_multibyte_string (nchars
, nbytes
);
675 memcpy (SDATA (val
), contents
, nbytes
);
676 if (SBYTES (val
) == SCHARS (val
))
677 STRING_SET_UNIBYTE (val
);
682 /* Make a string from NCHARS characters occupying NBYTES bytes at
683 CONTENTS. The argument MULTIBYTE controls whether to label the
684 string as multibyte. If NCHARS is negative, it counts the number of
685 characters by itself. */
688 make_specified_string (const char *contents
,
689 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
696 nchars
= multibyte_chars_in_text ((const unsigned char *) contents
,
701 val
= make_uninit_multibyte_string (nchars
, nbytes
);
702 memcpy (SDATA (val
), contents
, nbytes
);
704 STRING_SET_UNIBYTE (val
);
709 /* Return an unibyte Lisp_String set up to hold LENGTH characters
710 occupying LENGTH bytes. */
713 make_uninit_string (EMACS_INT length
)
718 return empty_unibyte_string
;
719 val
= make_uninit_multibyte_string (length
, length
);
720 STRING_SET_UNIBYTE (val
);
725 /* Return a multibyte Lisp_String set up to hold NCHARS characters
726 which occupy NBYTES bytes. */
729 make_uninit_multibyte_string (EMACS_INT nchars
, EMACS_INT nbytes
)
736 return empty_multibyte_string
;
738 string
= allocate_string ();
739 ((struct Lisp_String
*) SCM_SMOB_DATA (string
))->intervals
= NULL
;
740 allocate_string_data (string
, nchars
, nbytes
);
744 /* Print arguments to BUF according to a FORMAT, then return
745 a Lisp_String initialized with the data from BUF. */
748 make_formatted_string (char *buf
, const char *format
, ...)
753 va_start (ap
, format
);
754 length
= vsprintf (buf
, format
, ap
);
756 return make_string (buf
, length
);
760 /***********************************************************************
762 ***********************************************************************/
764 /* Return a new float object with value FLOAT_VALUE. */
767 make_float (double float_value
)
769 return scm_from_double (float_value
);
773 /***********************************************************************
775 ***********************************************************************/
777 DEFUN ("cons", Fcons
, Scons
, 2, 2, 0,
778 doc
: /* Create a new cons, give it CAR and CDR as components, and return it. */)
779 (Lisp_Object car
, Lisp_Object cdr
)
781 return scm_cons (car
, cdr
);
784 /* Make a list of 1, 2, 3, 4 or 5 specified objects. */
787 list1 (Lisp_Object arg1
)
789 return Fcons (arg1
, Qnil
);
793 list2 (Lisp_Object arg1
, Lisp_Object arg2
)
795 return Fcons (arg1
, Fcons (arg2
, Qnil
));
800 list3 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
)
802 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Qnil
)));
807 list4 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
)
809 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
, Qnil
))));
814 list5 (Lisp_Object arg1
, Lisp_Object arg2
, Lisp_Object arg3
, Lisp_Object arg4
, Lisp_Object arg5
)
816 return Fcons (arg1
, Fcons (arg2
, Fcons (arg3
, Fcons (arg4
,
817 Fcons (arg5
, Qnil
)))));
820 /* Make a list of COUNT Lisp_Objects, where ARG is the
821 first one. Allocate conses from pure space if TYPE
822 is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
825 listn (enum constype type
, ptrdiff_t count
, Lisp_Object arg
, ...)
829 Lisp_Object val
, *objp
;
831 /* Change to SAFE_ALLOCA if you hit this eassert. */
832 eassert (count
<= MAX_ALLOCA
/ word_size
);
834 objp
= alloca (count
* word_size
);
837 for (i
= 1; i
< count
; i
++)
838 objp
[i
] = va_arg (ap
, Lisp_Object
);
841 for (val
= Qnil
, i
= count
- 1; i
>= 0; i
--)
843 if (type
== CONSTYPE_PURE
)
844 val
= pure_cons (objp
[i
], val
);
845 else if (type
== CONSTYPE_HEAP
)
846 val
= Fcons (objp
[i
], val
);
853 DEFUN ("list", Flist
, Slist
, 0, MANY
, 0,
854 doc
: /* Return a newly created list with specified arguments as elements.
855 Any number of arguments, even zero arguments, are allowed.
856 usage: (list &rest OBJECTS) */)
857 (ptrdiff_t nargs
, Lisp_Object
*args
)
859 register Lisp_Object val
;
865 val
= Fcons (args
[nargs
], val
);
871 DEFUN ("make-list", Fmake_list
, Smake_list
, 2, 2, 0,
872 doc
: /* Return a newly created list of length LENGTH, with each element being INIT. */)
873 (register Lisp_Object length
, Lisp_Object init
)
875 register Lisp_Object val
;
876 register EMACS_INT size
;
878 CHECK_NATNUM (length
);
879 size
= XFASTINT (length
);
884 val
= Fcons (init
, val
);
889 val
= Fcons (init
, val
);
894 val
= Fcons (init
, val
);
899 val
= Fcons (init
, val
);
904 val
= Fcons (init
, val
);
919 /***********************************************************************
921 ***********************************************************************/
923 /* The only vector with 0 slots, allocated from pure space. */
925 Lisp_Object zero_vector
;
927 /* Called once to initialize vector allocation. */
932 struct Lisp_Vector
*p
= xmalloc (header_size
);
934 SCM_NEWSMOB (p
->header
.self
, lisp_vectorlike_tag
, p
);
936 XSETVECTOR (zero_vector
, p
);
939 /* Value is a pointer to a newly allocated Lisp_Vector structure
940 with room for LEN Lisp_Objects. */
942 static struct Lisp_Vector
*
943 allocate_vectorlike (ptrdiff_t len
)
945 struct Lisp_Vector
*p
;
948 p
= XVECTOR (zero_vector
);
951 p
= xmalloc (header_size
+ len
* word_size
);
952 SCM_NEWSMOB (p
->header
.self
, lisp_vectorlike_tag
, p
);
959 /* Allocate a vector with LEN slots. */
962 allocate_vector (EMACS_INT len
)
964 struct Lisp_Vector
*v
;
965 ptrdiff_t nbytes_max
= min (PTRDIFF_MAX
, SIZE_MAX
);
967 if (min ((nbytes_max
- header_size
) / word_size
, MOST_POSITIVE_FIXNUM
) < len
)
968 memory_full (SIZE_MAX
);
969 v
= allocate_vectorlike (len
);
970 v
->header
.size
= len
;
975 /* Allocate other vector-like structures. */
978 allocate_pseudovector (int memlen
, int lisplen
, enum pvec_type tag
)
980 struct Lisp_Vector
*v
= allocate_vectorlike (memlen
);
983 /* Catch bogus values. */
984 eassert (tag
<= PVEC_FONT
);
985 eassert (memlen
- lisplen
<= (1 << PSEUDOVECTOR_REST_BITS
) - 1);
986 eassert (lisplen
<= (1 << PSEUDOVECTOR_SIZE_BITS
) - 1);
988 /* Only the first lisplen slots will be traced normally by the GC. */
989 for (i
= 0; i
< lisplen
; ++i
)
990 v
->contents
[i
] = Qnil
;
992 XSETPVECTYPESIZE (v
, tag
, lisplen
, memlen
- lisplen
);
997 allocate_buffer (void)
999 struct buffer
*b
= xmalloc (sizeof *b
);
1001 SCM_NEWSMOB (b
->header
.self
, lisp_vectorlike_tag
, b
);
1002 BUFFER_PVEC_INIT (b
);
1003 /* Put B on the chain of all buffers including killed ones. */
1004 b
->next
= all_buffers
;
1006 /* Note that the rest fields of B are not initialized. */
1010 struct Lisp_Hash_Table
*
1011 allocate_hash_table (void)
1013 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table
, count
, PVEC_HASH_TABLE
);
1017 allocate_window (void)
1021 w
= ALLOCATE_PSEUDOVECTOR (struct window
, current_matrix
, PVEC_WINDOW
);
1022 /* Users assumes that non-Lisp data is zeroed. */
1023 memset (&w
->current_matrix
, 0,
1024 sizeof (*w
) - offsetof (struct window
, current_matrix
));
1029 allocate_terminal (void)
1033 t
= ALLOCATE_PSEUDOVECTOR (struct terminal
, next_terminal
, PVEC_TERMINAL
);
1034 /* Users assumes that non-Lisp data is zeroed. */
1035 memset (&t
->next_terminal
, 0,
1036 sizeof (*t
) - offsetof (struct terminal
, next_terminal
));
1041 allocate_frame (void)
1045 f
= ALLOCATE_PSEUDOVECTOR (struct frame
, face_cache
, PVEC_FRAME
);
1046 /* Users assumes that non-Lisp data is zeroed. */
1047 memset (&f
->face_cache
, 0,
1048 sizeof (*f
) - offsetof (struct frame
, face_cache
));
1052 struct Lisp_Process
*
1053 allocate_process (void)
1055 struct Lisp_Process
*p
;
1057 p
= ALLOCATE_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
1058 /* Users assumes that non-Lisp data is zeroed. */
1060 sizeof (*p
) - offsetof (struct Lisp_Process
, pid
));
1064 DEFUN ("make-vector", Fmake_vector
, Smake_vector
, 2, 2, 0,
1065 doc
: /* Return a newly created vector of length LENGTH, with each element being INIT.
1066 See also the function `vector'. */)
1067 (register Lisp_Object length
, Lisp_Object init
)
1070 register ptrdiff_t sizei
;
1071 register ptrdiff_t i
;
1072 register struct Lisp_Vector
*p
;
1074 CHECK_NATNUM (length
);
1076 p
= allocate_vector (XFASTINT (length
));
1077 sizei
= XFASTINT (length
);
1078 for (i
= 0; i
< sizei
; i
++)
1079 p
->contents
[i
] = init
;
1081 XSETVECTOR (vector
, p
);
1086 DEFUN ("vector", Fvector
, Svector
, 0, MANY
, 0,
1087 doc
: /* Return a newly created vector with specified arguments as elements.
1088 Any number of arguments, even zero arguments, are allowed.
1089 usage: (vector &rest OBJECTS) */)
1090 (ptrdiff_t nargs
, Lisp_Object
*args
)
1093 register Lisp_Object val
= make_uninit_vector (nargs
);
1094 register struct Lisp_Vector
*p
= XVECTOR (val
);
1096 for (i
= 0; i
< nargs
; i
++)
1097 p
->contents
[i
] = args
[i
];
1102 make_byte_code (struct Lisp_Vector
*v
)
1104 /* Don't allow the global zero_vector to become a byte code object. */
1105 eassert (0 < v
->header
.size
);
1107 if (v
->header
.size
> 1 && STRINGP (v
->contents
[1])
1108 && STRING_MULTIBYTE (v
->contents
[1]))
1109 /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
1110 earlier because they produced a raw 8-bit string for byte-code
1111 and now such a byte-code string is loaded as multibyte while
1112 raw 8-bit characters converted to multibyte form. Thus, now we
1113 must convert them back to the original unibyte form. */
1114 v
->contents
[1] = Fstring_as_unibyte (v
->contents
[1]);
1115 XSETPVECTYPE (v
, PVEC_COMPILED
);
1118 DEFUN ("make-byte-code", Fmake_byte_code
, Smake_byte_code
, 4, MANY
, 0,
1119 doc
: /* Create a byte-code object with specified arguments as elements.
1120 The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
1121 vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
1122 and (optional) INTERACTIVE-SPEC.
1123 The first four arguments are required; at most six have any
1125 The ARGLIST can be either like the one of `lambda', in which case the arguments
1126 will be dynamically bound before executing the byte code, or it can be an
1127 integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
1128 minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
1129 of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
1130 argument to catch the left-over arguments. If such an integer is used, the
1131 arguments will not be dynamically bound but will be instead pushed on the
1132 stack before executing the byte-code.
1133 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
1134 (ptrdiff_t nargs
, Lisp_Object
*args
)
1137 register Lisp_Object val
= make_uninit_vector (nargs
);
1138 register struct Lisp_Vector
*p
= XVECTOR (val
);
1140 /* We used to purecopy everything here, if purify-flag was set. This worked
1141 OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
1142 dangerous, since make-byte-code is used during execution to build
1143 closures, so any closure built during the preload phase would end up
1144 copied into pure space, including its free variables, which is sometimes
1145 just wasteful and other times plainly wrong (e.g. those free vars may want
1148 for (i
= 0; i
< nargs
; i
++)
1149 p
->contents
[i
] = args
[i
];
1151 XSETCOMPILED (val
, p
);
1157 /***********************************************************************
1159 ***********************************************************************/
1161 DEFUN ("make-symbol", Fmake_symbol
, Smake_symbol
, 1, 1, 0,
1162 doc
: /* Return a newly allocated uninterned symbol whose name is NAME.
1163 Its value is void, and its function definition and property list are nil. */)
1166 register Lisp_Object val
;
1168 CHECK_STRING (name
);
1170 val
= scm_make_symbol (scm_from_utf8_stringn (SSDATA (name
),
1177 /***********************************************************************
1178 Marker (Misc) Allocation
1179 ***********************************************************************/
1181 /* Return a newly allocated Lisp_Misc object of specified TYPE. */
1184 allocate_misc (enum Lisp_Misc_Type type
)
1189 p
= xmalloc (sizeof *p
);
1190 SCM_NEWSMOB (p
->u_any
.self
, lisp_misc_tag
, p
);
1192 XMISCANY (val
)->type
= type
;
1196 /* Free a Lisp_Misc object. */
1199 free_misc (Lisp_Object misc
)
1204 /* Verify properties of Lisp_Save_Value's representation
1205 that are assumed here and elsewhere. */
1207 verify (SAVE_UNUSED
== 0);
1208 verify (((SAVE_INTEGER
| SAVE_POINTER
| SAVE_FUNCPOINTER
| SAVE_OBJECT
)
1212 /* Return Lisp_Save_Value objects for the various combinations
1213 that callers need. */
1216 make_save_int_int_int (ptrdiff_t a
, ptrdiff_t b
, ptrdiff_t c
)
1218 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1219 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1220 p
->save_type
= SAVE_TYPE_INT_INT_INT
;
1221 p
->data
[0].integer
= a
;
1222 p
->data
[1].integer
= b
;
1223 p
->data
[2].integer
= c
;
1228 make_save_obj_obj_obj_obj (Lisp_Object a
, Lisp_Object b
, Lisp_Object c
,
1231 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1232 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1233 p
->save_type
= SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
;
1234 p
->data
[0].object
= a
;
1235 p
->data
[1].object
= b
;
1236 p
->data
[2].object
= c
;
1237 p
->data
[3].object
= d
;
1242 make_save_ptr (void *a
)
1244 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1245 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1246 p
->save_type
= SAVE_POINTER
;
1247 p
->data
[0].pointer
= a
;
1252 make_save_ptr_int (void *a
, ptrdiff_t b
)
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_PTR_INT
;
1257 p
->data
[0].pointer
= a
;
1258 p
->data
[1].integer
= b
;
1262 #if ! (defined USE_X_TOOLKIT || defined USE_GTK)
1264 make_save_ptr_ptr (void *a
, void *b
)
1266 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1267 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1268 p
->save_type
= SAVE_TYPE_PTR_PTR
;
1269 p
->data
[0].pointer
= a
;
1270 p
->data
[1].pointer
= b
;
1276 make_save_funcptr_ptr_obj (void (*a
) (void), void *b
, Lisp_Object c
)
1278 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1279 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1280 p
->save_type
= SAVE_TYPE_FUNCPTR_PTR_OBJ
;
1281 p
->data
[0].funcpointer
= a
;
1282 p
->data
[1].pointer
= b
;
1283 p
->data
[2].object
= c
;
1287 /* Return a Lisp_Save_Value object that represents an array A
1288 of N Lisp objects. */
1291 make_save_memory (Lisp_Object
*a
, ptrdiff_t n
)
1293 Lisp_Object val
= allocate_misc (Lisp_Misc_Save_Value
);
1294 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
1295 p
->save_type
= SAVE_TYPE_MEMORY
;
1296 p
->data
[0].pointer
= a
;
1297 p
->data
[1].integer
= n
;
1301 /* Free a Lisp_Save_Value object. Do not use this function
1302 if SAVE contains pointer other than returned by xmalloc. */
1305 free_save_value (Lisp_Object save
)
1307 xfree (XSAVE_POINTER (save
, 0));
1311 /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
1314 build_overlay (Lisp_Object start
, Lisp_Object end
, Lisp_Object plist
)
1316 register Lisp_Object overlay
;
1318 overlay
= allocate_misc (Lisp_Misc_Overlay
);
1319 OVERLAY_START (overlay
) = start
;
1320 OVERLAY_END (overlay
) = end
;
1321 set_overlay_plist (overlay
, plist
);
1322 XOVERLAY (overlay
)->next
= NULL
;
1326 DEFUN ("make-marker", Fmake_marker
, Smake_marker
, 0, 0, 0,
1327 doc
: /* Return a newly allocated marker which does not point at any place. */)
1330 register Lisp_Object val
;
1331 register struct Lisp_Marker
*p
;
1333 val
= allocate_misc (Lisp_Misc_Marker
);
1339 p
->insertion_type
= 0;
1340 p
->need_adjustment
= 0;
1344 /* Return a newly allocated marker which points into BUF
1345 at character position CHARPOS and byte position BYTEPOS. */
1348 build_marker (struct buffer
*buf
, ptrdiff_t charpos
, ptrdiff_t bytepos
)
1351 struct Lisp_Marker
*m
;
1353 /* No dead buffers here. */
1354 eassert (BUFFER_LIVE_P (buf
));
1356 /* Every character is at least one byte. */
1357 eassert (charpos
<= bytepos
);
1359 obj
= allocate_misc (Lisp_Misc_Marker
);
1362 m
->charpos
= charpos
;
1363 m
->bytepos
= bytepos
;
1364 m
->insertion_type
= 0;
1365 m
->need_adjustment
= 0;
1366 m
->next
= BUF_MARKERS (buf
);
1367 BUF_MARKERS (buf
) = m
;
1371 /* Return a newly created vector or string with specified arguments as
1372 elements. If all the arguments are characters that can fit
1373 in a string of events, make a string; otherwise, make a vector.
1375 Any number of arguments, even zero arguments, are allowed. */
1378 make_event_array (ptrdiff_t nargs
, Lisp_Object
*args
)
1382 for (i
= 0; i
< nargs
; i
++)
1383 /* The things that fit in a string
1384 are characters that are in 0...127,
1385 after discarding the meta bit and all the bits above it. */
1386 if (!INTEGERP (args
[i
])
1387 || (XINT (args
[i
]) & ~(-CHAR_META
)) >= 0200)
1388 return Fvector (nargs
, args
);
1390 /* Since the loop exited, we know that all the things in it are
1391 characters, so we can make a string. */
1395 result
= Fmake_string (make_number (nargs
), make_number (0));
1396 for (i
= 0; i
< nargs
; i
++)
1398 SSET (result
, i
, XINT (args
[i
]));
1399 /* Move the meta bit to the right place for a string char. */
1400 if (XINT (args
[i
]) & CHAR_META
)
1401 SSET (result
, i
, SREF (result
, i
) | 0x80);
1410 /************************************************************************
1411 Memory Full Handling
1412 ************************************************************************/
1415 /* Called if xmalloc (NBYTES) returns zero. If NBYTES == SIZE_MAX,
1416 there may have been size_t overflow so that xmalloc was never
1417 called, or perhaps xmalloc was invoked successfully but the
1418 resulting pointer had problems fitting into a tagged EMACS_INT. In
1419 either case this counts as memory being full even though xmalloc
1423 memory_full (size_t nbytes
)
1425 /* Do not go into hysterics merely because a large request failed. */
1426 bool enough_free_memory
= 0;
1427 if (SPARE_MEMORY
< nbytes
)
1429 void *p
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1433 enough_free_memory
= 1;
1437 if (! enough_free_memory
)
1441 /* The first time we get here, free the spare memory. */
1444 xfree (spare_memory
);
1445 spare_memory
= NULL
;
1449 /* This used to call error, but if we've run out of memory, we could
1450 get infinite recursion trying to build the string. */
1451 xsignal (Qnil
, Vmemory_signal_data
);
1454 /* If we released our reserve (due to running out of memory),
1455 and we have a fair amount free once again,
1456 try to set aside another reserve in case we run out once more.
1458 This is called when a relocatable block is freed in ralloc.c,
1459 and also directly from this file, in case we're not using ralloc.c. */
1462 refill_memory_reserve (void)
1464 if (spare_memory
== NULL
)
1465 spare_memory
= xmalloc_atomic_unsafe (SPARE_MEMORY
);
1468 Vmemory_full
= Qnil
;
1471 /* Determine whether it is safe to access memory at address P. */
1473 valid_pointer_p (void *p
)
1476 return w32_valid_pointer_p (p
, 16);
1480 /* Obviously, we cannot just access it (we would SEGV trying), so we
1481 trick the o/s to tell us whether p is a valid pointer.
1482 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
1483 not validate p in that case. */
1485 if (emacs_pipe (fd
) == 0)
1487 bool valid
= emacs_write (fd
[1], p
, 16) == 16;
1488 emacs_close (fd
[1]);
1489 emacs_close (fd
[0]);
1497 /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
1498 valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
1499 cannot validate OBJ. This function can be quite slow, so its primary
1500 use is the manual debugging. The only exception is print_object, where
1501 we use it to check whether the memory referenced by the pointer of
1502 Lisp_Save_Value object contains valid objects. */
1505 valid_lisp_object_p (Lisp_Object obj
)
1512 p
= (void *) SCM2PTR (obj
);
1514 if (p
== &buffer_defaults
|| p
== &buffer_local_symbols
)
1517 return valid_pointer_p (p
);
1520 /* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
1521 (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
1522 if not. Otherwise we can't rely on valid_lisp_object_p and return -1.
1523 This function is slow and should be used for debugging purposes. */
1526 relocatable_string_data_p (const char *str
)
1531 /***********************************************************************
1532 Pure Storage Compatibility Functions
1533 ***********************************************************************/
1536 check_pure_size (void)
1542 make_pure_string (const char *data
,
1543 ptrdiff_t nchars
, ptrdiff_t nbytes
, bool multibyte
)
1545 return make_specified_string (data
, nchars
, nbytes
, multibyte
);
1549 make_pure_c_string (const char *data
, ptrdiff_t nchars
)
1551 return build_string (data
);
1555 pure_cons (Lisp_Object car
, Lisp_Object cdr
)
1557 return Fcons (car
, cdr
);
1560 DEFUN ("purecopy", Fpurecopy
, Spurecopy
, 1, 1, 0,
1561 doc
: /* Return OBJ. */)
1562 (register Lisp_Object obj
)
1567 /***********************************************************************
1569 ***********************************************************************/
1572 staticpro (Lisp_Object
*varaddress
)
1577 DEFUN ("garbage-collect", Fgarbage_collect
, Sgarbage_collect
, 0, 0, "",
1578 doc
: /* Reclaim storage for Lisp objects no longer needed.
1579 Garbage collection happens automatically if you cons more than
1580 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
1581 `garbage-collect' normally returns a list with info on amount of space in use,
1582 where each entry has the form (NAME SIZE USED FREE), where:
1583 - NAME is a symbol describing the kind of objects this entry represents,
1584 - SIZE is the number of bytes used by each one,
1585 - USED is the number of those objects that were found live in the heap,
1586 - FREE is the number of those objects that are not live but that Emacs
1587 keeps around for future allocations (maybe because it does not know how
1588 to return them to the OS).
1589 However, if there was overflow in pure space, `garbage-collect'
1590 returns nil, because real GC can't be done.
1591 See Info node `(elisp)Garbage Collection'. */)
1598 #ifdef ENABLE_CHECKING
1600 bool suppress_checking
;
1603 die (const char *msg
, const char *file
, int line
)
1605 fprintf (stderr
, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
1607 terminate_due_to_signal (SIGABRT
, INT_MAX
);
1611 /* Initialization. */
1614 print_lisp_string (SCM obj
, SCM port
, scm_print_state
*pstate
)
1616 scm_c_write (port
, "#<elisp-string \"", 16);
1617 scm_c_write (port
, XSTRING (obj
)->data
, STRING_BYTES (XSTRING (obj
)));
1618 scm_c_write (port
, "\">", 2);
1623 init_alloc_once (void)
1625 lisp_misc_tag
= scm_make_smob_type ("elisp-misc", 0);
1626 lisp_string_tag
= scm_make_smob_type ("elisp-string",
1627 sizeof (struct Lisp_String
));
1628 scm_set_smob_print (lisp_string_tag
, print_lisp_string
);
1629 lisp_vectorlike_tag
= scm_make_smob_type ("elisp-vectorlike", 0);
1631 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
1636 refill_memory_reserve ();
1637 gc_cons_threshold
= GC_DEFAULT_THRESHOLD
;
1644 Vgc_elapsed
= make_float (0.0);
1648 valgrind_p
= RUNNING_ON_VALGRIND
!= 0;
1653 syms_of_alloc (void)
1657 DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold
,
1658 doc
: /* Number of bytes of consing between garbage collections.
1659 Garbage collection can happen automatically once this many bytes have been
1660 allocated since the last garbage collection. All data types count.
1662 Garbage collection happens automatically only when `eval' is called.
1664 By binding this temporarily to a large number, you can effectively
1665 prevent garbage collection during a part of the program.
1666 See also `gc-cons-percentage'. */);
1668 DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage
,
1669 doc
: /* Portion of the heap used for allocation.
1670 Garbage collection can happen automatically once this portion of the heap
1671 has been allocated since the last garbage collection.
1672 If this portion is smaller than `gc-cons-threshold', this is ignored. */);
1673 Vgc_cons_percentage
= make_float (0.1);
1675 DEFVAR_INT ("pure-bytes-used", pure_bytes_used
,
1676 doc
: /* Number of bytes of shareable Lisp data allocated so far. */);
1678 DEFVAR_LISP ("purify-flag", Vpurify_flag
,
1679 doc
: /* Non-nil means loading Lisp code in order to dump an executable.
1680 This means that certain objects should be allocated in shared (pure) space.
1681 It can also be set to a hash-table, in which case this table is used to
1682 do hash-consing of the objects allocated to pure space. */);
1684 DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages
,
1685 doc
: /* Non-nil means display messages at start and end of garbage collection. */);
1686 garbage_collection_messages
= 0;
1688 DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook
,
1689 doc
: /* Hook run after garbage collection has finished. */);
1690 Vpost_gc_hook
= Qnil
;
1691 DEFSYM (Qpost_gc_hook
, "post-gc-hook");
1693 DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data
,
1694 doc
: /* Precomputed `signal' argument for memory-full error. */);
1695 /* We build this in advance because if we wait until we need it, we might
1696 not be able to allocate the memory to hold it. */
1698 = listn (CONSTYPE_PURE
, 2, Qerror
,
1699 build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
1701 DEFVAR_LISP ("memory-full", Vmemory_full
,
1702 doc
: /* Non-nil means Emacs cannot get much more Lisp memory. */);
1703 Vmemory_full
= Qnil
;
1705 DEFSYM (Qgc_cons_threshold
, "gc-cons-threshold");
1706 DEFSYM (Qchar_table_extra_slots
, "char-table-extra-slots");
1708 DEFVAR_LISP ("gc-elapsed", Vgc_elapsed
,
1709 doc
: /* Accumulated time elapsed in garbage collections.
1710 The time is in seconds as a floating point value. */);
1711 DEFVAR_INT ("gcs-done", gcs_done
,
1712 doc
: /* Accumulated number of garbage collections done. */);
1715 /* When compiled with GCC, GDB might say "No enum type named
1716 pvec_type" if we don't have at least one symbol with that type, and
1717 then xbacktrace could fail. Similarly for the other enums and
1718 their values. Some non-GCC compilers don't like these constructs. */
1722 enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS
;
1723 enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS
;
1724 enum char_bits char_bits
;
1725 enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE
;
1726 enum Lisp_Bits Lisp_Bits
;
1727 enum Lisp_Compiled Lisp_Compiled
;
1728 enum maxargs maxargs
;
1729 enum MAX_ALLOCA MAX_ALLOCA
;
1730 enum More_Lisp_Bits More_Lisp_Bits
;
1731 enum pvec_type pvec_type
;
1732 } const EXTERNALLY_VISIBLE gdb_make_enums_visible
= {0};
1733 #endif /* __GNUC__ */