1 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
24 #include "intervals.h"
30 #include "blockinput.h"
34 #include "syssignal.h"
38 /* The following come from gmalloc.c. */
40 #if defined (__STDC__) && __STDC__
42 #define __malloc_size_t size_t
44 #define __malloc_size_t unsigned int
46 extern __malloc_size_t _bytes_used
;
47 extern int __malloc_extra_blocks
;
49 #define max(A,B) ((A) > (B) ? (A) : (B))
50 #define min(A,B) ((A) < (B) ? (A) : (B))
52 /* Macro to verify that storage intended for Lisp objects is not
53 out of range to fit in the space for a pointer.
54 ADDRESS is the start of the block, and SIZE
55 is the amount of space within which objects can start. */
56 #define VALIDATE_LISP_STORAGE(address, size) \
60 XSETCONS (val, (char *) address + size); \
61 if ((char *) XCONS (val) != (char *) address + size) \
68 /* Value of _bytes_used, when spare_memory was freed. */
69 static __malloc_size_t bytes_used_when_full
;
71 /* Number of bytes of consing done since the last gc */
74 /* Number of bytes of consing since gc before another gc should be done. */
75 int gc_cons_threshold
;
77 /* Nonzero during gc */
80 #ifndef VIRT_ADDR_VARIES
82 #endif /* VIRT_ADDR_VARIES */
85 #ifndef VIRT_ADDR_VARIES
87 #endif /* VIRT_ADDR_VARIES */
88 int malloc_sbrk_unused
;
90 /* Two limits controlling how much undo information to keep. */
92 int undo_strong_limit
;
94 /* Points to memory space allocated as "spare",
95 to be freed if we run out of memory. */
96 static char *spare_memory
;
98 /* Amount of spare memory to keep in reserve. */
99 #define SPARE_MEMORY (1 << 14)
101 /* Number of extra blocks malloc should get when it needs more core. */
102 static int malloc_hysteresis
;
104 /* Nonzero when malloc is called for allocating Lisp object space. */
105 int allocating_for_lisp
;
107 /* Non-nil means defun should do purecopy on the function definition */
108 Lisp_Object Vpurify_flag
;
111 EMACS_INT pure
[PURESIZE
/ sizeof (EMACS_INT
)] = {0,}; /* Force it into data space! */
112 #define PUREBEG (char *) pure
114 #define pure PURE_SEG_BITS /* Use shared memory segment */
115 #define PUREBEG (char *)PURE_SEG_BITS
117 /* This variable is used only by the XPNTR macro when HAVE_SHM is
118 defined. If we used the PURESIZE macro directly there, that would
119 make most of emacs dependent on puresize.h, which we don't want -
120 you should be able to change that without too much recompilation.
121 So map_in_data initializes pure_size, and the dependencies work
124 #endif /* not HAVE_SHM */
126 /* Index in pure at which next pure object will be allocated. */
129 /* If nonzero, this is a warning delivered by malloc and not yet displayed. */
130 char *pending_malloc_warning
;
132 /* Pre-computed signal argument for use when memory is exhausted. */
133 Lisp_Object memory_signal_data
;
135 /* Maximum amount of C stack to save when a GC happens. */
137 #ifndef MAX_SAVE_STACK
138 #define MAX_SAVE_STACK 16000
141 /* Define DONT_COPY_FLAG to be some bit which will always be zero in a
142 pointer to a Lisp_Object, when that pointer is viewed as an integer.
143 (On most machines, pointers are even, so we can use the low bit.
144 Word-addressible architectures may need to override this in the m-file.)
145 When linking references to small strings through the size field, we
146 use this slot to hold the bit that would otherwise be interpreted as
148 #ifndef DONT_COPY_FLAG
149 #define DONT_COPY_FLAG 1
150 #endif /* no DONT_COPY_FLAG */
152 /* Buffer in which we save a copy of the C stack at each GC. */
157 /* Non-zero means ignore malloc warnings. Set during initialization. */
160 Lisp_Object Qgc_cons_threshold
;
162 static void mark_object (), mark_buffer (), mark_kboards ();
163 static void clear_marks (), gc_sweep ();
164 static void compact_strings ();
166 /* Versions of malloc and realloc that print warnings as memory gets full. */
169 malloc_warning_1 (str
)
172 Fprinc (str
, Vstandard_output
);
173 write_string ("\nKilling some buffers may delay running out of memory.\n", -1);
174 write_string ("However, certainly by the time you receive the 95% warning,\n", -1);
175 write_string ("you should clean up, kill this Emacs, and start a new one.", -1);
179 /* malloc calls this if it finds we are near exhausting storage */
183 pending_malloc_warning
= str
;
186 display_malloc_warning ()
188 register Lisp_Object val
;
190 val
= build_string (pending_malloc_warning
);
191 pending_malloc_warning
= 0;
192 internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1
, val
);
195 /* Called if malloc returns zero */
199 #ifndef SYSTEM_MALLOC
200 bytes_used_when_full
= _bytes_used
;
203 /* The first time we get here, free the spare memory. */
210 /* This used to call error, but if we've run out of memory, we could get
211 infinite recursion trying to build the string. */
213 Fsignal (Qerror
, memory_signal_data
);
216 /* Called if we can't allocate relocatable space for a buffer. */
219 buffer_memory_full ()
221 /* If buffers use the relocating allocator,
222 no need to free spare_memory, because we may have plenty of malloc
223 space left that we could get, and if we don't, the malloc that fails
224 will itself cause spare_memory to be freed.
225 If buffers don't use the relocating allocator,
226 treat this like any other failing malloc. */
232 /* This used to call error, but if we've run out of memory, we could get
233 infinite recursion trying to build the string. */
235 Fsignal (Qerror
, memory_signal_data
);
238 /* like malloc routines but check for no memory and block interrupt input. */
247 val
= (long *) malloc (size
);
250 if (!val
&& size
) memory_full ();
255 xrealloc (block
, size
)
262 /* We must call malloc explicitly when BLOCK is 0, since some
263 reallocs don't do this. */
265 val
= (long *) malloc (size
);
267 val
= (long *) realloc (block
, size
);
270 if (!val
&& size
) memory_full ();
284 /* Arranging to disable input signals while we're in malloc.
286 This only works with GNU malloc. To help out systems which can't
287 use GNU malloc, all the calls to malloc, realloc, and free
288 elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
289 pairs; unfortunately, we have no idea what C library functions
290 might call malloc, so we can't really protect them unless you're
291 using GNU malloc. Fortunately, most of the major operating can use
294 #ifndef SYSTEM_MALLOC
295 extern void * (*__malloc_hook
) ();
296 static void * (*old_malloc_hook
) ();
297 extern void * (*__realloc_hook
) ();
298 static void * (*old_realloc_hook
) ();
299 extern void (*__free_hook
) ();
300 static void (*old_free_hook
) ();
302 /* This function is used as the hook for free to call. */
305 emacs_blocked_free (ptr
)
309 __free_hook
= old_free_hook
;
311 /* If we released our reserve (due to running out of memory),
312 and we have a fair amount free once again,
313 try to set aside another reserve in case we run out once more. */
314 if (spare_memory
== 0
315 /* Verify there is enough space that even with the malloc
316 hysteresis this call won't run out again.
317 The code here is correct as long as SPARE_MEMORY
318 is substantially larger than the block size malloc uses. */
319 && (bytes_used_when_full
320 > _bytes_used
+ max (malloc_hysteresis
, 4) * SPARE_MEMORY
))
321 spare_memory
= (char *) malloc (SPARE_MEMORY
);
323 __free_hook
= emacs_blocked_free
;
327 /* If we released our reserve (due to running out of memory),
328 and we have a fair amount free once again,
329 try to set aside another reserve in case we run out once more.
331 This is called when a relocatable block is freed in ralloc.c. */
334 refill_memory_reserve ()
336 if (spare_memory
== 0)
337 spare_memory
= (char *) malloc (SPARE_MEMORY
);
340 /* This function is the malloc hook that Emacs uses. */
343 emacs_blocked_malloc (size
)
349 __malloc_hook
= old_malloc_hook
;
350 __malloc_extra_blocks
= malloc_hysteresis
;
351 value
= (void *) malloc (size
);
352 __malloc_hook
= emacs_blocked_malloc
;
359 emacs_blocked_realloc (ptr
, size
)
366 __realloc_hook
= old_realloc_hook
;
367 value
= (void *) realloc (ptr
, size
);
368 __realloc_hook
= emacs_blocked_realloc
;
375 uninterrupt_malloc ()
377 old_free_hook
= __free_hook
;
378 __free_hook
= emacs_blocked_free
;
380 old_malloc_hook
= __malloc_hook
;
381 __malloc_hook
= emacs_blocked_malloc
;
383 old_realloc_hook
= __realloc_hook
;
384 __realloc_hook
= emacs_blocked_realloc
;
388 /* Interval allocation. */
390 #ifdef USE_TEXT_PROPERTIES
391 #define INTERVAL_BLOCK_SIZE \
392 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
394 struct interval_block
396 struct interval_block
*next
;
397 struct interval intervals
[INTERVAL_BLOCK_SIZE
];
400 struct interval_block
*interval_block
;
401 static int interval_block_index
;
403 INTERVAL interval_free_list
;
408 allocating_for_lisp
= 1;
410 = (struct interval_block
*) malloc (sizeof (struct interval_block
));
411 allocating_for_lisp
= 0;
412 interval_block
->next
= 0;
413 bzero (interval_block
->intervals
, sizeof interval_block
->intervals
);
414 interval_block_index
= 0;
415 interval_free_list
= 0;
418 #define INIT_INTERVALS init_intervals ()
425 if (interval_free_list
)
427 val
= interval_free_list
;
428 interval_free_list
= interval_free_list
->parent
;
432 if (interval_block_index
== INTERVAL_BLOCK_SIZE
)
434 register struct interval_block
*newi
;
436 allocating_for_lisp
= 1;
437 newi
= (struct interval_block
*) xmalloc (sizeof (struct interval_block
));
439 allocating_for_lisp
= 0;
440 VALIDATE_LISP_STORAGE (newi
, sizeof *newi
);
441 newi
->next
= interval_block
;
442 interval_block
= newi
;
443 interval_block_index
= 0;
445 val
= &interval_block
->intervals
[interval_block_index
++];
447 consing_since_gc
+= sizeof (struct interval
);
448 RESET_INTERVAL (val
);
452 static int total_free_intervals
, total_intervals
;
454 /* Mark the pointers of one interval. */
457 mark_interval (i
, dummy
)
461 if (XMARKBIT (i
->plist
))
463 mark_object (&i
->plist
);
468 mark_interval_tree (tree
)
469 register INTERVAL tree
;
471 /* No need to test if this tree has been marked already; this
472 function is always called through the MARK_INTERVAL_TREE macro,
473 which takes care of that. */
475 /* XMARK expands to an assignment; the LHS of an assignment can't be
477 XMARK (* (Lisp_Object
*) &tree
->parent
);
479 traverse_intervals (tree
, 1, 0, mark_interval
, Qnil
);
482 #define MARK_INTERVAL_TREE(i) \
484 if (!NULL_INTERVAL_P (i) \
485 && ! XMARKBIT ((Lisp_Object) i->parent)) \
486 mark_interval_tree (i); \
489 /* The oddity in the call to XUNMARK is necessary because XUNMARK
490 expands to an assignment to its argument, and most C compilers don't
491 support casts on the left operand of `='. */
492 #define UNMARK_BALANCE_INTERVALS(i) \
494 if (! NULL_INTERVAL_P (i)) \
496 XUNMARK (* (Lisp_Object *) (&(i)->parent)); \
497 (i) = balance_intervals (i); \
501 #else /* no interval use */
503 #define INIT_INTERVALS
505 #define UNMARK_BALANCE_INTERVALS(i)
506 #define MARK_INTERVAL_TREE(i)
508 #endif /* no interval use */
510 /* Floating point allocation. */
512 #ifdef LISP_FLOAT_TYPE
513 /* Allocation of float cells, just like conses */
514 /* We store float cells inside of float_blocks, allocating a new
515 float_block with malloc whenever necessary. Float cells reclaimed by
516 GC are put on a free list to be reallocated before allocating
517 any new float cells from the latest float_block.
519 Each float_block is just under 1020 bytes long,
520 since malloc really allocates in units of powers of two
521 and uses 4 bytes for its own overhead. */
523 #define FLOAT_BLOCK_SIZE \
524 ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
528 struct float_block
*next
;
529 struct Lisp_Float floats
[FLOAT_BLOCK_SIZE
];
532 struct float_block
*float_block
;
533 int float_block_index
;
535 struct Lisp_Float
*float_free_list
;
540 allocating_for_lisp
= 1;
541 float_block
= (struct float_block
*) malloc (sizeof (struct float_block
));
542 allocating_for_lisp
= 0;
543 float_block
->next
= 0;
544 bzero (float_block
->floats
, sizeof float_block
->floats
);
545 float_block_index
= 0;
549 /* Explicitly free a float cell. */
551 struct Lisp_Float
*ptr
;
553 *(struct Lisp_Float
**)&ptr
->type
= float_free_list
;
554 float_free_list
= ptr
;
558 make_float (float_value
)
561 register Lisp_Object val
;
565 XSETFLOAT (val
, float_free_list
);
566 float_free_list
= *(struct Lisp_Float
**)&float_free_list
->type
;
570 if (float_block_index
== FLOAT_BLOCK_SIZE
)
572 register struct float_block
*new;
574 allocating_for_lisp
= 1;
575 new = (struct float_block
*) xmalloc (sizeof (struct float_block
));
576 allocating_for_lisp
= 0;
577 VALIDATE_LISP_STORAGE (new, sizeof *new);
578 new->next
= float_block
;
580 float_block_index
= 0;
582 XSETFLOAT (val
, &float_block
->floats
[float_block_index
++]);
584 XFLOAT (val
)->data
= float_value
;
585 XSETFASTINT (XFLOAT (val
)->type
, 0); /* bug chasing -wsr */
586 consing_since_gc
+= sizeof (struct Lisp_Float
);
590 #endif /* LISP_FLOAT_TYPE */
592 /* Allocation of cons cells */
593 /* We store cons cells inside of cons_blocks, allocating a new
594 cons_block with malloc whenever necessary. Cons cells reclaimed by
595 GC are put on a free list to be reallocated before allocating
596 any new cons cells from the latest cons_block.
598 Each cons_block is just under 1020 bytes long,
599 since malloc really allocates in units of powers of two
600 and uses 4 bytes for its own overhead. */
602 #define CONS_BLOCK_SIZE \
603 ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
607 struct cons_block
*next
;
608 struct Lisp_Cons conses
[CONS_BLOCK_SIZE
];
611 struct cons_block
*cons_block
;
612 int cons_block_index
;
614 struct Lisp_Cons
*cons_free_list
;
619 allocating_for_lisp
= 1;
620 cons_block
= (struct cons_block
*) malloc (sizeof (struct cons_block
));
621 allocating_for_lisp
= 0;
622 cons_block
->next
= 0;
623 bzero (cons_block
->conses
, sizeof cons_block
->conses
);
624 cons_block_index
= 0;
628 /* Explicitly free a cons cell. */
630 struct Lisp_Cons
*ptr
;
632 *(struct Lisp_Cons
**)&ptr
->car
= cons_free_list
;
633 cons_free_list
= ptr
;
636 DEFUN ("cons", Fcons
, Scons
, 2, 2, 0,
637 "Create a new cons, give it CAR and CDR as components, and return it.")
639 Lisp_Object car
, cdr
;
641 register Lisp_Object val
;
645 XSETCONS (val
, cons_free_list
);
646 cons_free_list
= *(struct Lisp_Cons
**)&cons_free_list
->car
;
650 if (cons_block_index
== CONS_BLOCK_SIZE
)
652 register struct cons_block
*new;
653 allocating_for_lisp
= 1;
654 new = (struct cons_block
*) xmalloc (sizeof (struct cons_block
));
655 allocating_for_lisp
= 0;
656 VALIDATE_LISP_STORAGE (new, sizeof *new);
657 new->next
= cons_block
;
659 cons_block_index
= 0;
661 XSETCONS (val
, &cons_block
->conses
[cons_block_index
++]);
663 XCONS (val
)->car
= car
;
664 XCONS (val
)->cdr
= cdr
;
665 consing_since_gc
+= sizeof (struct Lisp_Cons
);
669 DEFUN ("list", Flist
, Slist
, 0, MANY
, 0,
670 "Return a newly created list with specified arguments as elements.\n\
671 Any number of arguments, even zero arguments, are allowed.")
674 register Lisp_Object
*args
;
676 register Lisp_Object val
= Qnil
;
679 val
= Fcons (args
[nargs
], val
);
683 DEFUN ("make-list", Fmake_list
, Smake_list
, 2, 2, 0,
684 "Return a newly created list of length LENGTH, with each element being INIT.")
686 register Lisp_Object length
, init
;
688 register Lisp_Object val
;
691 CHECK_NATNUM (length
, 0);
692 size
= XFASTINT (length
);
696 val
= Fcons (init
, val
);
700 /* Allocation of vectors */
702 struct Lisp_Vector
*all_vectors
;
705 allocate_vectorlike (len
)
708 struct Lisp_Vector
*p
;
710 allocating_for_lisp
= 1;
711 p
= (struct Lisp_Vector
*)xmalloc (sizeof (struct Lisp_Vector
)
712 + (len
- 1) * sizeof (Lisp_Object
));
713 allocating_for_lisp
= 0;
714 VALIDATE_LISP_STORAGE (p
, 0);
715 consing_since_gc
+= (sizeof (struct Lisp_Vector
)
716 + (len
- 1) * sizeof (Lisp_Object
));
718 p
->next
= all_vectors
;
723 DEFUN ("make-vector", Fmake_vector
, Smake_vector
, 2, 2, 0,
724 "Return a newly created vector of length LENGTH, with each element being INIT.\n\
725 See also the function `vector'.")
727 register Lisp_Object length
, init
;
730 register EMACS_INT sizei
;
732 register struct Lisp_Vector
*p
;
734 CHECK_NATNUM (length
, 0);
735 sizei
= XFASTINT (length
);
737 p
= allocate_vectorlike (sizei
);
739 for (index
= 0; index
< sizei
; index
++)
740 p
->contents
[index
] = init
;
742 XSETVECTOR (vector
, p
);
746 DEFUN ("vector", Fvector
, Svector
, 0, MANY
, 0,
747 "Return a newly created vector with specified arguments as elements.\n\
748 Any number of arguments, even zero arguments, are allowed.")
753 register Lisp_Object len
, val
;
755 register struct Lisp_Vector
*p
;
757 XSETFASTINT (len
, nargs
);
758 val
= Fmake_vector (len
, Qnil
);
760 for (index
= 0; index
< nargs
; index
++)
761 p
->contents
[index
] = args
[index
];
765 DEFUN ("make-byte-code", Fmake_byte_code
, Smake_byte_code
, 4, MANY
, 0,
766 "Create a byte-code object with specified arguments as elements.\n\
767 The arguments should be the arglist, bytecode-string, constant vector,\n\
768 stack size, (optional) doc string, and (optional) interactive spec.\n\
769 The first four arguments are required; at most six have any\n\
775 register Lisp_Object len
, val
;
777 register struct Lisp_Vector
*p
;
779 XSETFASTINT (len
, nargs
);
780 if (!NILP (Vpurify_flag
))
781 val
= make_pure_vector (len
);
783 val
= Fmake_vector (len
, Qnil
);
785 for (index
= 0; index
< nargs
; index
++)
787 if (!NILP (Vpurify_flag
))
788 args
[index
] = Fpurecopy (args
[index
]);
789 p
->contents
[index
] = args
[index
];
791 XSETCOMPILED (val
, val
);
795 /* Allocation of symbols.
796 Just like allocation of conses!
798 Each symbol_block is just under 1020 bytes long,
799 since malloc really allocates in units of powers of two
800 and uses 4 bytes for its own overhead. */
802 #define SYMBOL_BLOCK_SIZE \
803 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
807 struct symbol_block
*next
;
808 struct Lisp_Symbol symbols
[SYMBOL_BLOCK_SIZE
];
811 struct symbol_block
*symbol_block
;
812 int symbol_block_index
;
814 struct Lisp_Symbol
*symbol_free_list
;
819 allocating_for_lisp
= 1;
820 symbol_block
= (struct symbol_block
*) malloc (sizeof (struct symbol_block
));
821 allocating_for_lisp
= 0;
822 symbol_block
->next
= 0;
823 bzero (symbol_block
->symbols
, sizeof symbol_block
->symbols
);
824 symbol_block_index
= 0;
825 symbol_free_list
= 0;
828 DEFUN ("make-symbol", Fmake_symbol
, Smake_symbol
, 1, 1, 0,
829 "Return a newly allocated uninterned symbol whose name is NAME.\n\
830 Its value and function definition are void, and its property list is nil.")
834 register Lisp_Object val
;
835 register struct Lisp_Symbol
*p
;
837 CHECK_STRING (str
, 0);
839 if (symbol_free_list
)
841 XSETSYMBOL (val
, symbol_free_list
);
842 symbol_free_list
= *(struct Lisp_Symbol
**)&symbol_free_list
->value
;
846 if (symbol_block_index
== SYMBOL_BLOCK_SIZE
)
848 struct symbol_block
*new;
849 allocating_for_lisp
= 1;
850 new = (struct symbol_block
*) xmalloc (sizeof (struct symbol_block
));
851 allocating_for_lisp
= 0;
852 VALIDATE_LISP_STORAGE (new, sizeof *new);
853 new->next
= symbol_block
;
855 symbol_block_index
= 0;
857 XSETSYMBOL (val
, &symbol_block
->symbols
[symbol_block_index
++]);
860 p
->name
= XSTRING (str
);
863 p
->function
= Qunbound
;
865 consing_since_gc
+= sizeof (struct Lisp_Symbol
);
869 /* Allocation of markers and other objects that share that structure.
870 Works like allocation of conses. */
872 #define MARKER_BLOCK_SIZE \
873 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
877 struct marker_block
*next
;
878 union Lisp_Misc markers
[MARKER_BLOCK_SIZE
];
881 struct marker_block
*marker_block
;
882 int marker_block_index
;
884 union Lisp_Misc
*marker_free_list
;
889 allocating_for_lisp
= 1;
890 marker_block
= (struct marker_block
*) malloc (sizeof (struct marker_block
));
891 allocating_for_lisp
= 0;
892 marker_block
->next
= 0;
893 bzero (marker_block
->markers
, sizeof marker_block
->markers
);
894 marker_block_index
= 0;
895 marker_free_list
= 0;
898 /* Return a newly allocated Lisp_Misc object, with no substructure. */
904 if (marker_free_list
)
906 XSETMISC (val
, marker_free_list
);
907 marker_free_list
= marker_free_list
->u_free
.chain
;
911 if (marker_block_index
== MARKER_BLOCK_SIZE
)
913 struct marker_block
*new;
914 allocating_for_lisp
= 1;
915 new = (struct marker_block
*) xmalloc (sizeof (struct marker_block
));
916 allocating_for_lisp
= 0;
917 VALIDATE_LISP_STORAGE (new, sizeof *new);
918 new->next
= marker_block
;
920 marker_block_index
= 0;
922 XSETMISC (val
, &marker_block
->markers
[marker_block_index
++]);
924 consing_since_gc
+= sizeof (union Lisp_Misc
);
928 DEFUN ("make-marker", Fmake_marker
, Smake_marker
, 0, 0, 0,
929 "Return a newly allocated marker which does not point at any place.")
932 register Lisp_Object val
;
933 register struct Lisp_Marker
*p
;
935 val
= allocate_misc ();
936 XMISCTYPE (val
) = Lisp_Misc_Marker
;
944 /* Allocation of strings */
946 /* Strings reside inside of string_blocks. The entire data of the string,
947 both the size and the contents, live in part of the `chars' component of a string_block.
948 The `pos' component is the index within `chars' of the first free byte.
950 first_string_block points to the first string_block ever allocated.
951 Each block points to the next one with its `next' field.
952 The `prev' fields chain in reverse order.
953 The last one allocated is the one currently being filled.
954 current_string_block points to it.
956 The string_blocks that hold individual large strings
957 go in a separate chain, started by large_string_blocks. */
960 /* String blocks contain this many useful bytes.
961 8188 is power of 2, minus 4 for malloc overhead. */
962 #define STRING_BLOCK_SIZE (8188 - sizeof (struct string_block_head))
964 /* A string bigger than this gets its own specially-made string block
965 if it doesn't fit in the current one. */
966 #define STRING_BLOCK_OUTSIZE 1024
968 struct string_block_head
970 struct string_block
*next
, *prev
;
976 struct string_block
*next
, *prev
;
978 char chars
[STRING_BLOCK_SIZE
];
981 /* This points to the string block we are now allocating strings. */
983 struct string_block
*current_string_block
;
985 /* This points to the oldest string block, the one that starts the chain. */
987 struct string_block
*first_string_block
;
989 /* Last string block in chain of those made for individual large strings. */
991 struct string_block
*large_string_blocks
;
993 /* If SIZE is the length of a string, this returns how many bytes
994 the string occupies in a string_block (including padding). */
996 #define STRING_FULLSIZE(size) (((size) + sizeof (struct Lisp_String) + PAD) \
998 #define PAD (sizeof (EMACS_INT))
1001 #define STRING_FULLSIZE(SIZE) \
1002 (((SIZE) + 2 * sizeof (EMACS_INT)) & ~(sizeof (EMACS_INT) - 1))
1008 allocating_for_lisp
= 1;
1009 current_string_block
= (struct string_block
*) malloc (sizeof (struct string_block
));
1010 allocating_for_lisp
= 0;
1011 first_string_block
= current_string_block
;
1012 consing_since_gc
+= sizeof (struct string_block
);
1013 current_string_block
->next
= 0;
1014 current_string_block
->prev
= 0;
1015 current_string_block
->pos
= 0;
1016 large_string_blocks
= 0;
1019 DEFUN ("make-string", Fmake_string
, Smake_string
, 2, 2, 0,
1020 "Return a newly created string of length LENGTH, with each element being INIT.\n\
1021 Both LENGTH and INIT must be numbers.")
1023 Lisp_Object length
, init
;
1025 register Lisp_Object val
;
1026 register unsigned char *p
, *end
, c
;
1028 CHECK_NATNUM (length
, 0);
1029 CHECK_NUMBER (init
, 1);
1030 val
= make_uninit_string (XFASTINT (length
));
1032 p
= XSTRING (val
)->data
;
1033 end
= p
+ XSTRING (val
)->size
;
1041 make_string (contents
, length
)
1045 register Lisp_Object val
;
1046 val
= make_uninit_string (length
);
1047 bcopy (contents
, XSTRING (val
)->data
, length
);
1055 return make_string (str
, strlen (str
));
1059 make_uninit_string (length
)
1062 register Lisp_Object val
;
1063 register int fullsize
= STRING_FULLSIZE (length
);
1065 if (length
< 0) abort ();
1067 if (fullsize
<= STRING_BLOCK_SIZE
- current_string_block
->pos
)
1068 /* This string can fit in the current string block */
1071 ((struct Lisp_String
*)
1072 (current_string_block
->chars
+ current_string_block
->pos
)));
1073 current_string_block
->pos
+= fullsize
;
1075 else if (fullsize
> STRING_BLOCK_OUTSIZE
)
1076 /* This string gets its own string block */
1078 register struct string_block
*new;
1079 allocating_for_lisp
= 1;
1080 new = (struct string_block
*) xmalloc (sizeof (struct string_block_head
) + fullsize
);
1081 allocating_for_lisp
= 0;
1082 VALIDATE_LISP_STORAGE (new, 0);
1083 consing_since_gc
+= sizeof (struct string_block_head
) + fullsize
;
1084 new->pos
= fullsize
;
1085 new->next
= large_string_blocks
;
1086 large_string_blocks
= new;
1088 ((struct Lisp_String
*)
1089 ((struct string_block_head
*)new + 1)));
1092 /* Make a new current string block and start it off with this string */
1094 register struct string_block
*new;
1095 allocating_for_lisp
= 1;
1096 new = (struct string_block
*) xmalloc (sizeof (struct string_block
));
1097 allocating_for_lisp
= 0;
1098 VALIDATE_LISP_STORAGE (new, sizeof *new);
1099 consing_since_gc
+= sizeof (struct string_block
);
1100 current_string_block
->next
= new;
1101 new->prev
= current_string_block
;
1103 current_string_block
= new;
1104 new->pos
= fullsize
;
1106 (struct Lisp_String
*) current_string_block
->chars
);
1109 XSTRING (val
)->size
= length
;
1110 XSTRING (val
)->data
[length
] = 0;
1111 INITIALIZE_INTERVAL (XSTRING (val
), NULL_INTERVAL
);
1116 /* Return a newly created vector or string with specified arguments as
1117 elements. If all the arguments are characters that can fit
1118 in a string of events, make a string; otherwise, make a vector.
1120 Any number of arguments, even zero arguments, are allowed. */
1123 make_event_array (nargs
, args
)
1129 for (i
= 0; i
< nargs
; i
++)
1130 /* The things that fit in a string
1131 are characters that are in 0...127,
1132 after discarding the meta bit and all the bits above it. */
1133 if (!INTEGERP (args
[i
])
1134 || (XUINT (args
[i
]) & ~(-CHAR_META
)) >= 0200)
1135 return Fvector (nargs
, args
);
1137 /* Since the loop exited, we know that all the things in it are
1138 characters, so we can make a string. */
1142 result
= Fmake_string (nargs
, make_number (0));
1143 for (i
= 0; i
< nargs
; i
++)
1145 XSTRING (result
)->data
[i
] = XINT (args
[i
]);
1146 /* Move the meta bit to the right place for a string char. */
1147 if (XINT (args
[i
]) & CHAR_META
)
1148 XSTRING (result
)->data
[i
] |= 0x80;
1155 /* Pure storage management. */
1157 /* Must get an error if pure storage is full,
1158 since if it cannot hold a large string
1159 it may be able to hold conses that point to that string;
1160 then the string is not protected from gc. */
1163 make_pure_string (data
, length
)
1167 register Lisp_Object
new;
1168 register int size
= sizeof (EMACS_INT
) + INTERVAL_PTR_SIZE
+ length
+ 1;
1170 if (pureptr
+ size
> PURESIZE
)
1171 error ("Pure Lisp storage exhausted");
1172 XSETSTRING (new, PUREBEG
+ pureptr
);
1173 XSTRING (new)->size
= length
;
1174 bcopy (data
, XSTRING (new)->data
, length
);
1175 XSTRING (new)->data
[length
] = 0;
1177 /* We must give strings in pure storage some kind of interval. So we
1178 give them a null one. */
1179 #if defined (USE_TEXT_PROPERTIES)
1180 XSTRING (new)->intervals
= NULL_INTERVAL
;
1182 pureptr
+= (size
+ sizeof (EMACS_INT
) - 1)
1183 / sizeof (EMACS_INT
) * sizeof (EMACS_INT
);
1188 pure_cons (car
, cdr
)
1189 Lisp_Object car
, cdr
;
1191 register Lisp_Object
new;
1193 if (pureptr
+ sizeof (struct Lisp_Cons
) > PURESIZE
)
1194 error ("Pure Lisp storage exhausted");
1195 XSETCONS (new, PUREBEG
+ pureptr
);
1196 pureptr
+= sizeof (struct Lisp_Cons
);
1197 XCONS (new)->car
= Fpurecopy (car
);
1198 XCONS (new)->cdr
= Fpurecopy (cdr
);
1202 #ifdef LISP_FLOAT_TYPE
1205 make_pure_float (num
)
1208 register Lisp_Object
new;
1210 /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof
1211 (double) boundary. Some architectures (like the sparc) require
1212 this, and I suspect that floats are rare enough that it's no
1213 tragedy for those that do. */
1216 char *p
= PUREBEG
+ pureptr
;
1220 alignment
= __alignof (struct Lisp_Float
);
1222 alignment
= sizeof (struct Lisp_Float
);
1225 alignment
= sizeof (struct Lisp_Float
);
1227 p
= (char *) (((unsigned long) p
+ alignment
- 1) & - alignment
);
1228 pureptr
= p
- PUREBEG
;
1231 if (pureptr
+ sizeof (struct Lisp_Float
) > PURESIZE
)
1232 error ("Pure Lisp storage exhausted");
1233 XSETFLOAT (new, PUREBEG
+ pureptr
);
1234 pureptr
+= sizeof (struct Lisp_Float
);
1235 XFLOAT (new)->data
= num
;
1236 XSETFASTINT (XFLOAT (new)->type
, 0); /* bug chasing -wsr */
1240 #endif /* LISP_FLOAT_TYPE */
1243 make_pure_vector (len
)
1246 register Lisp_Object
new;
1247 register EMACS_INT size
= sizeof (struct Lisp_Vector
) + (len
- 1) * sizeof (Lisp_Object
);
1249 if (pureptr
+ size
> PURESIZE
)
1250 error ("Pure Lisp storage exhausted");
1252 XSETVECTOR (new, PUREBEG
+ pureptr
);
1254 XVECTOR (new)->size
= len
;
1258 DEFUN ("purecopy", Fpurecopy
, Spurecopy
, 1, 1, 0,
1259 "Make a copy of OBJECT in pure storage.\n\
1260 Recursively copies contents of vectors and cons cells.\n\
1261 Does not copy symbols.")
1263 register Lisp_Object obj
;
1265 if (NILP (Vpurify_flag
))
1268 if ((PNTR_COMPARISON_TYPE
) XPNTR (obj
) < (PNTR_COMPARISON_TYPE
) ((char *) pure
+ PURESIZE
)
1269 && (PNTR_COMPARISON_TYPE
) XPNTR (obj
) >= (PNTR_COMPARISON_TYPE
) pure
)
1273 return pure_cons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1274 #ifdef LISP_FLOAT_TYPE
1275 else if (FLOATP (obj
))
1276 return make_pure_float (XFLOAT (obj
)->data
);
1277 #endif /* LISP_FLOAT_TYPE */
1278 else if (STRINGP (obj
))
1279 return make_pure_string (XSTRING (obj
)->data
, XSTRING (obj
)->size
);
1280 else if (COMPILEDP (obj
) || VECTORP (obj
))
1282 register struct Lisp_Vector
*vec
;
1283 register int i
, size
;
1285 size
= XVECTOR (obj
)->size
;
1286 if (size
& PSEUDOVECTOR_FLAG
)
1287 size
&= PSEUDOVECTOR_SIZE_MASK
;
1288 vec
= XVECTOR (make_pure_vector (size
));
1289 for (i
= 0; i
< size
; i
++)
1290 vec
->contents
[i
] = Fpurecopy (XVECTOR (obj
)->contents
[i
]);
1291 if (COMPILEDP (obj
))
1292 XSETCOMPILED (obj
, vec
);
1294 XSETVECTOR (obj
, vec
);
1297 else if (MARKERP (obj
))
1298 error ("Attempt to copy a marker to pure storage");
1303 /* Recording what needs to be marked for gc. */
1305 struct gcpro
*gcprolist
;
1307 #define NSTATICS 768
1309 Lisp_Object
*staticvec
[NSTATICS
] = {0};
1313 /* Put an entry in staticvec, pointing at the variable whose address is given */
1316 staticpro (varaddress
)
1317 Lisp_Object
*varaddress
;
1319 staticvec
[staticidx
++] = varaddress
;
1320 if (staticidx
>= NSTATICS
)
1328 struct catchtag
*next
;
1329 /* jmp_buf jmp; /* We don't need this for GC purposes */
1334 struct backtrace
*next
;
1335 Lisp_Object
*function
;
1336 Lisp_Object
*args
; /* Points to vector of args. */
1337 int nargs
; /* length of vector */
1338 /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */
1342 /* Garbage collection! */
1344 int total_conses
, total_markers
, total_symbols
, total_string_size
, total_vector_size
;
1345 int total_free_conses
, total_free_markers
, total_free_symbols
;
1346 #ifdef LISP_FLOAT_TYPE
1347 int total_free_floats
, total_floats
;
1348 #endif /* LISP_FLOAT_TYPE */
1350 /* Temporarily prevent garbage collection. */
1353 inhibit_garbage_collection ()
1355 int count
= specpdl_ptr
- specpdl
;
1357 int nbits
= min (VALBITS
, INTBITS
);
1359 XSETINT (number
, ((EMACS_INT
) 1 << (nbits
- 1)) - 1);
1361 specbind (Qgc_cons_threshold
, number
);
1366 DEFUN ("garbage-collect", Fgarbage_collect
, Sgarbage_collect
, 0, 0, "",
1367 "Reclaim storage for Lisp objects no longer needed.\n\
1368 Returns info on amount of space in use:\n\
1369 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\
1370 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS\n\
1371 (USED-FLOATS . FREE-FLOATS))\n\
1372 Garbage collection happens automatically if you cons more than\n\
1373 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.")
1376 register struct gcpro
*tail
;
1377 register struct specbinding
*bind
;
1378 struct catchtag
*catch;
1379 struct handler
*handler
;
1380 register struct backtrace
*backlist
;
1381 register Lisp_Object tem
;
1382 char *omessage
= echo_area_glyphs
;
1383 int omessage_length
= echo_area_glyphs_length
;
1384 char stack_top_variable
;
1387 /* In case user calls debug_print during GC,
1388 don't let that cause a recursive GC. */
1389 consing_since_gc
= 0;
1391 /* Save a copy of the contents of the stack, for debugging. */
1392 #if MAX_SAVE_STACK > 0
1393 if (NILP (Vpurify_flag
))
1395 i
= &stack_top_variable
- stack_bottom
;
1397 if (i
< MAX_SAVE_STACK
)
1399 if (stack_copy
== 0)
1400 stack_copy
= (char *) xmalloc (stack_copy_size
= i
);
1401 else if (stack_copy_size
< i
)
1402 stack_copy
= (char *) xrealloc (stack_copy
, (stack_copy_size
= i
));
1405 if ((EMACS_INT
) (&stack_top_variable
- stack_bottom
) > 0)
1406 bcopy (stack_bottom
, stack_copy
, i
);
1408 bcopy (&stack_top_variable
, stack_copy
, i
);
1412 #endif /* MAX_SAVE_STACK > 0 */
1414 if (!noninteractive
)
1415 message1_nolog ("Garbage collecting...");
1417 /* Don't keep command history around forever */
1418 tem
= Fnthcdr (make_number (30), Vcommand_history
);
1420 XCONS (tem
)->cdr
= Qnil
;
1422 /* Likewise for undo information. */
1424 register struct buffer
*nextb
= all_buffers
;
1428 /* If a buffer's undo list is Qt, that means that undo is
1429 turned off in that buffer. Calling truncate_undo_list on
1430 Qt tends to return NULL, which effectively turns undo back on.
1431 So don't call truncate_undo_list if undo_list is Qt. */
1432 if (! EQ (nextb
->undo_list
, Qt
))
1434 = truncate_undo_list (nextb
->undo_list
, undo_limit
,
1436 nextb
= nextb
->next
;
1442 /* clear_marks (); */
1444 /* In each "large string", set the MARKBIT of the size field.
1445 That enables mark_object to recognize them. */
1447 register struct string_block
*b
;
1448 for (b
= large_string_blocks
; b
; b
= b
->next
)
1449 ((struct Lisp_String
*)(&b
->chars
[0]))->size
|= MARKBIT
;
1452 /* Mark all the special slots that serve as the roots of accessibility.
1454 Usually the special slots to mark are contained in particular structures.
1455 Then we know no slot is marked twice because the structures don't overlap.
1456 In some cases, the structures point to the slots to be marked.
1457 For these, we use MARKBIT to avoid double marking of the slot. */
1459 for (i
= 0; i
< staticidx
; i
++)
1460 mark_object (staticvec
[i
]);
1461 for (tail
= gcprolist
; tail
; tail
= tail
->next
)
1462 for (i
= 0; i
< tail
->nvars
; i
++)
1463 if (!XMARKBIT (tail
->var
[i
]))
1465 mark_object (&tail
->var
[i
]);
1466 XMARK (tail
->var
[i
]);
1468 for (bind
= specpdl
; bind
!= specpdl_ptr
; bind
++)
1470 mark_object (&bind
->symbol
);
1471 mark_object (&bind
->old_value
);
1473 for (catch = catchlist
; catch; catch = catch->next
)
1475 mark_object (&catch->tag
);
1476 mark_object (&catch->val
);
1478 for (handler
= handlerlist
; handler
; handler
= handler
->next
)
1480 mark_object (&handler
->handler
);
1481 mark_object (&handler
->var
);
1483 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
1485 if (!XMARKBIT (*backlist
->function
))
1487 mark_object (backlist
->function
);
1488 XMARK (*backlist
->function
);
1490 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
1493 i
= backlist
->nargs
- 1;
1495 if (!XMARKBIT (backlist
->args
[i
]))
1497 mark_object (&backlist
->args
[i
]);
1498 XMARK (backlist
->args
[i
]);
1505 /* Clear the mark bits that we set in certain root slots. */
1507 for (tail
= gcprolist
; tail
; tail
= tail
->next
)
1508 for (i
= 0; i
< tail
->nvars
; i
++)
1509 XUNMARK (tail
->var
[i
]);
1510 for (backlist
= backtrace_list
; backlist
; backlist
= backlist
->next
)
1512 XUNMARK (*backlist
->function
);
1513 if (backlist
->nargs
== UNEVALLED
|| backlist
->nargs
== MANY
)
1516 i
= backlist
->nargs
- 1;
1518 XUNMARK (backlist
->args
[i
]);
1520 XUNMARK (buffer_defaults
.name
);
1521 XUNMARK (buffer_local_symbols
.name
);
1523 /* clear_marks (); */
1526 consing_since_gc
= 0;
1527 if (gc_cons_threshold
< 10000)
1528 gc_cons_threshold
= 10000;
1530 if (omessage
|| minibuf_level
> 0)
1531 message2_nolog (omessage
, omessage_length
);
1532 else if (!noninteractive
)
1533 message1_nolog ("Garbage collecting...done");
1535 return Fcons (Fcons (make_number (total_conses
),
1536 make_number (total_free_conses
)),
1537 Fcons (Fcons (make_number (total_symbols
),
1538 make_number (total_free_symbols
)),
1539 Fcons (Fcons (make_number (total_markers
),
1540 make_number (total_free_markers
)),
1541 Fcons (make_number (total_string_size
),
1542 Fcons (make_number (total_vector_size
),
1544 #ifdef LISP_FLOAT_TYPE
1545 Fcons (Fcons (make_number (total_floats
),
1546 make_number (total_free_floats
)),
1548 #else /* not LISP_FLOAT_TYPE */
1550 #endif /* not LISP_FLOAT_TYPE */
1558 /* Clear marks on all conses */
1560 register struct cons_block
*cblk
;
1561 register int lim
= cons_block_index
;
1563 for (cblk
= cons_block
; cblk
; cblk
= cblk
->next
)
1566 for (i
= 0; i
< lim
; i
++)
1567 XUNMARK (cblk
->conses
[i
].car
);
1568 lim
= CONS_BLOCK_SIZE
;
1571 /* Clear marks on all symbols */
1573 register struct symbol_block
*sblk
;
1574 register int lim
= symbol_block_index
;
1576 for (sblk
= symbol_block
; sblk
; sblk
= sblk
->next
)
1579 for (i
= 0; i
< lim
; i
++)
1581 XUNMARK (sblk
->symbols
[i
].plist
);
1583 lim
= SYMBOL_BLOCK_SIZE
;
1586 /* Clear marks on all markers */
1588 register struct marker_block
*sblk
;
1589 register int lim
= marker_block_index
;
1591 for (sblk
= marker_block
; sblk
; sblk
= sblk
->next
)
1594 for (i
= 0; i
< lim
; i
++)
1595 if (sblk
->markers
[i
].u_marker
.type
== Lisp_Misc_Marker
)
1596 XUNMARK (sblk
->markers
[i
].u_marker
.chain
);
1597 lim
= MARKER_BLOCK_SIZE
;
1600 /* Clear mark bits on all buffers */
1602 register struct buffer
*nextb
= all_buffers
;
1606 XUNMARK (nextb
->name
);
1607 nextb
= nextb
->next
;
1613 /* Mark reference to a Lisp_Object.
1614 If the object referred to has not been seen yet, recursively mark
1615 all the references contained in it.
1617 If the object referenced is a short string, the referencing slot
1618 is threaded into a chain of such slots, pointed to from
1619 the `size' field of the string. The actual string size
1620 lives in the last slot in the chain. We recognize the end
1621 because it is < (unsigned) STRING_BLOCK_SIZE. */
1623 #define LAST_MARKED_SIZE 500
1624 Lisp_Object
*last_marked
[LAST_MARKED_SIZE
];
1625 int last_marked_index
;
1628 mark_object (objptr
)
1629 Lisp_Object
*objptr
;
1631 register Lisp_Object obj
;
1638 if ((PNTR_COMPARISON_TYPE
) XPNTR (obj
) < (PNTR_COMPARISON_TYPE
) ((char *) pure
+ PURESIZE
)
1639 && (PNTR_COMPARISON_TYPE
) XPNTR (obj
) >= (PNTR_COMPARISON_TYPE
) pure
)
1642 last_marked
[last_marked_index
++] = objptr
;
1643 if (last_marked_index
== LAST_MARKED_SIZE
)
1644 last_marked_index
= 0;
1646 switch (SWITCH_ENUM_CAST (XGCTYPE (obj
)))
1650 register struct Lisp_String
*ptr
= XSTRING (obj
);
1652 MARK_INTERVAL_TREE (ptr
->intervals
);
1653 if (ptr
->size
& MARKBIT
)
1654 /* A large string. Just set ARRAY_MARK_FLAG. */
1655 ptr
->size
|= ARRAY_MARK_FLAG
;
1658 /* A small string. Put this reference
1659 into the chain of references to it.
1660 If the address includes MARKBIT, put that bit elsewhere
1661 when we store OBJPTR into the size field. */
1663 if (XMARKBIT (*objptr
))
1665 XSETFASTINT (*objptr
, ptr
->size
);
1669 XSETFASTINT (*objptr
, ptr
->size
);
1671 if ((EMACS_INT
) objptr
& DONT_COPY_FLAG
)
1673 ptr
->size
= (EMACS_INT
) objptr
;
1674 if (ptr
->size
& MARKBIT
)
1675 ptr
->size
^= MARKBIT
| DONT_COPY_FLAG
;
1680 case Lisp_Vectorlike
:
1681 if (GC_BUFFERP (obj
))
1683 if (!XMARKBIT (XBUFFER (obj
)->name
))
1686 else if (GC_SUBRP (obj
))
1688 else if (GC_COMPILEDP (obj
))
1689 /* We could treat this just like a vector, but it is better
1690 to save the COMPILED_CONSTANTS element for last and avoid recursion
1693 register struct Lisp_Vector
*ptr
= XVECTOR (obj
);
1694 register EMACS_INT size
= ptr
->size
;
1695 /* See comment above under Lisp_Vector. */
1696 struct Lisp_Vector
*volatile ptr1
= ptr
;
1699 if (size
& ARRAY_MARK_FLAG
)
1700 break; /* Already marked */
1701 ptr
->size
|= ARRAY_MARK_FLAG
; /* Else mark it */
1702 size
&= PSEUDOVECTOR_SIZE_MASK
;
1703 for (i
= 0; i
< size
; i
++) /* and then mark its elements */
1705 if (i
!= COMPILED_CONSTANTS
)
1706 mark_object (&ptr1
->contents
[i
]);
1708 /* This cast should be unnecessary, but some Mips compiler complains
1709 (MIPS-ABI + SysVR4, DC/OSx, etc). */
1710 objptr
= (Lisp_Object
*) &ptr1
->contents
[COMPILED_CONSTANTS
];
1714 else if (GC_FRAMEP (obj
))
1716 /* See comment above under Lisp_Vector for why this is volatile. */
1717 register struct frame
*volatile ptr
= XFRAME (obj
);
1718 register EMACS_INT size
= ptr
->size
;
1720 if (size
& ARRAY_MARK_FLAG
) break; /* Already marked */
1721 ptr
->size
|= ARRAY_MARK_FLAG
; /* Else mark it */
1723 mark_object (&ptr
->name
);
1724 mark_object (&ptr
->icon_name
);
1725 mark_object (&ptr
->focus_frame
);
1726 mark_object (&ptr
->selected_window
);
1727 mark_object (&ptr
->minibuffer_window
);
1728 mark_object (&ptr
->param_alist
);
1729 mark_object (&ptr
->scroll_bars
);
1730 mark_object (&ptr
->condemned_scroll_bars
);
1731 mark_object (&ptr
->menu_bar_items
);
1732 mark_object (&ptr
->face_alist
);
1733 mark_object (&ptr
->menu_bar_vector
);
1734 mark_object (&ptr
->buffer_predicate
);
1736 #endif /* MULTI_FRAME */
1739 register struct Lisp_Vector
*ptr
= XVECTOR (obj
);
1740 register EMACS_INT size
= ptr
->size
;
1741 /* The reason we use ptr1 is to avoid an apparent hardware bug
1742 that happens occasionally on the FSF's HP 300s.
1743 The bug is that a2 gets clobbered by recursive calls to mark_object.
1744 The clobberage seems to happen during function entry,
1745 perhaps in the moveml instruction.
1746 Yes, this is a crock, but we have to do it. */
1747 struct Lisp_Vector
*volatile ptr1
= ptr
;
1750 if (size
& ARRAY_MARK_FLAG
) break; /* Already marked */
1751 ptr
->size
|= ARRAY_MARK_FLAG
; /* Else mark it */
1752 if (size
& PSEUDOVECTOR_FLAG
)
1753 size
&= PSEUDOVECTOR_SIZE_MASK
;
1754 for (i
= 0; i
< size
; i
++) /* and then mark its elements */
1755 mark_object (&ptr1
->contents
[i
]);
1761 /* See comment above under Lisp_Vector for why this is volatile. */
1762 register struct Lisp_Symbol
*volatile ptr
= XSYMBOL (obj
);
1763 struct Lisp_Symbol
*ptrx
;
1765 if (XMARKBIT (ptr
->plist
)) break;
1767 mark_object ((Lisp_Object
*) &ptr
->value
);
1768 mark_object (&ptr
->function
);
1769 mark_object (&ptr
->plist
);
1770 XSETTYPE (*(Lisp_Object
*) &ptr
->name
, Lisp_String
);
1771 mark_object (&ptr
->name
);
1775 /* For the benefit of the last_marked log. */
1776 objptr
= (Lisp_Object
*)&XSYMBOL (obj
)->next
;
1777 ptrx
= ptr
; /* Use of ptrx avoids compiler bug on Sun */
1778 XSETSYMBOL (obj
, ptrx
);
1779 /* We can't goto loop here because *objptr doesn't contain an
1780 actual Lisp_Object with valid datatype field. */
1787 switch (XMISCTYPE (obj
))
1789 case Lisp_Misc_Marker
:
1790 XMARK (XMARKER (obj
)->chain
);
1791 /* DO NOT mark thru the marker's chain.
1792 The buffer's markers chain does not preserve markers from gc;
1793 instead, markers are removed from the chain when freed by gc. */
1796 case Lisp_Misc_Buffer_Local_Value
:
1797 case Lisp_Misc_Some_Buffer_Local_Value
:
1799 register struct Lisp_Buffer_Local_Value
*ptr
1800 = XBUFFER_LOCAL_VALUE (obj
);
1801 if (XMARKBIT (ptr
->car
)) break;
1803 /* If the cdr is nil, avoid recursion for the car. */
1804 if (EQ (ptr
->cdr
, Qnil
))
1809 mark_object (&ptr
->car
);
1810 /* See comment above under Lisp_Vector for why not use ptr here. */
1811 objptr
= &XBUFFER_LOCAL_VALUE (obj
)->cdr
;
1815 case Lisp_Misc_Intfwd
:
1816 case Lisp_Misc_Boolfwd
:
1817 case Lisp_Misc_Objfwd
:
1818 case Lisp_Misc_Buffer_Objfwd
:
1819 case Lisp_Misc_Kboard_Objfwd
:
1820 /* Don't bother with Lisp_Buffer_Objfwd,
1821 since all markable slots in current buffer marked anyway. */
1822 /* Don't need to do Lisp_Objfwd, since the places they point
1823 are protected with staticpro. */
1826 case Lisp_Misc_Overlay
:
1828 struct Lisp_Overlay
*ptr
= XOVERLAY (obj
);
1829 if (!XMARKBIT (ptr
->plist
))
1832 mark_object (&ptr
->start
);
1833 mark_object (&ptr
->end
);
1834 objptr
= &ptr
->plist
;
1847 register struct Lisp_Cons
*ptr
= XCONS (obj
);
1848 if (XMARKBIT (ptr
->car
)) break;
1850 /* If the cdr is nil, avoid recursion for the car. */
1851 if (EQ (ptr
->cdr
, Qnil
))
1856 mark_object (&ptr
->car
);
1857 /* See comment above under Lisp_Vector for why not use ptr here. */
1858 objptr
= &XCONS (obj
)->cdr
;
1862 #ifdef LISP_FLOAT_TYPE
1864 XMARK (XFLOAT (obj
)->type
);
1866 #endif /* LISP_FLOAT_TYPE */
1876 /* Mark the pointers in a buffer structure. */
1882 register struct buffer
*buffer
= XBUFFER (buf
);
1883 register Lisp_Object
*ptr
;
1884 Lisp_Object base_buffer
;
1886 /* This is the buffer's markbit */
1887 mark_object (&buffer
->name
);
1888 XMARK (buffer
->name
);
1890 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer
));
1893 mark_object (buffer
->syntax_table
);
1895 /* Mark the various string-pointers in the buffer object.
1896 Since the strings may be relocated, we must mark them
1897 in their actual slots. So gc_sweep must convert each slot
1898 back to an ordinary C pointer. */
1899 XSETSTRING (*(Lisp_Object
*)&buffer
->upcase_table
, buffer
->upcase_table
);
1900 mark_object ((Lisp_Object
*)&buffer
->upcase_table
);
1901 XSETSTRING (*(Lisp_Object
*)&buffer
->downcase_table
, buffer
->downcase_table
);
1902 mark_object ((Lisp_Object
*)&buffer
->downcase_table
);
1904 XSETSTRING (*(Lisp_Object
*)&buffer
->sort_table
, buffer
->sort_table
);
1905 mark_object ((Lisp_Object
*)&buffer
->sort_table
);
1906 XSETSTRING (*(Lisp_Object
*)&buffer
->folding_sort_table
, buffer
->folding_sort_table
);
1907 mark_object ((Lisp_Object
*)&buffer
->folding_sort_table
);
1910 for (ptr
= &buffer
->name
+ 1;
1911 (char *)ptr
< (char *)buffer
+ sizeof (struct buffer
);
1915 /* If this is an indirect buffer, mark its base buffer. */
1916 if (buffer
->base_buffer
&& !XMARKBIT (buffer
->base_buffer
->name
))
1918 XSETBUFFER (base_buffer
, buffer
->base_buffer
);
1919 mark_buffer (base_buffer
);
1924 /* Mark the pointers in the kboard objects. */
1931 for (kb
= all_kboards
; kb
; kb
= kb
->next_kboard
)
1933 if (kb
->kbd_macro_buffer
)
1934 for (p
= kb
->kbd_macro_buffer
; p
< kb
->kbd_macro_ptr
; p
++)
1936 mark_object (&kb
->Vprefix_arg
);
1937 mark_object (&kb
->kbd_queue
);
1938 mark_object (&kb
->Vlast_kbd_macro
);
1939 mark_object (&kb
->Vsystem_key_alist
);
1940 mark_object (&kb
->system_key_syms
);
1944 /* Sweep: find all structures not marked, and free them. */
1949 total_string_size
= 0;
1952 /* Put all unmarked conses on free list */
1954 register struct cons_block
*cblk
;
1955 register int lim
= cons_block_index
;
1956 register int num_free
= 0, num_used
= 0;
1960 for (cblk
= cons_block
; cblk
; cblk
= cblk
->next
)
1963 for (i
= 0; i
< lim
; i
++)
1964 if (!XMARKBIT (cblk
->conses
[i
].car
))
1967 *(struct Lisp_Cons
**)&cblk
->conses
[i
].car
= cons_free_list
;
1968 cons_free_list
= &cblk
->conses
[i
];
1973 XUNMARK (cblk
->conses
[i
].car
);
1975 lim
= CONS_BLOCK_SIZE
;
1977 total_conses
= num_used
;
1978 total_free_conses
= num_free
;
1981 #ifdef LISP_FLOAT_TYPE
1982 /* Put all unmarked floats on free list */
1984 register struct float_block
*fblk
;
1985 register int lim
= float_block_index
;
1986 register int num_free
= 0, num_used
= 0;
1988 float_free_list
= 0;
1990 for (fblk
= float_block
; fblk
; fblk
= fblk
->next
)
1993 for (i
= 0; i
< lim
; i
++)
1994 if (!XMARKBIT (fblk
->floats
[i
].type
))
1997 *(struct Lisp_Float
**)&fblk
->floats
[i
].type
= float_free_list
;
1998 float_free_list
= &fblk
->floats
[i
];
2003 XUNMARK (fblk
->floats
[i
].type
);
2005 lim
= FLOAT_BLOCK_SIZE
;
2007 total_floats
= num_used
;
2008 total_free_floats
= num_free
;
2010 #endif /* LISP_FLOAT_TYPE */
2012 #ifdef USE_TEXT_PROPERTIES
2013 /* Put all unmarked intervals on free list */
2015 register struct interval_block
*iblk
;
2016 register int lim
= interval_block_index
;
2017 register int num_free
= 0, num_used
= 0;
2019 interval_free_list
= 0;
2021 for (iblk
= interval_block
; iblk
; iblk
= iblk
->next
)
2025 for (i
= 0; i
< lim
; i
++)
2027 if (! XMARKBIT (iblk
->intervals
[i
].plist
))
2029 iblk
->intervals
[i
].parent
= interval_free_list
;
2030 interval_free_list
= &iblk
->intervals
[i
];
2036 XUNMARK (iblk
->intervals
[i
].plist
);
2039 lim
= INTERVAL_BLOCK_SIZE
;
2041 total_intervals
= num_used
;
2042 total_free_intervals
= num_free
;
2044 #endif /* USE_TEXT_PROPERTIES */
2046 /* Put all unmarked symbols on free list */
2048 register struct symbol_block
*sblk
;
2049 register int lim
= symbol_block_index
;
2050 register int num_free
= 0, num_used
= 0;
2052 symbol_free_list
= 0;
2054 for (sblk
= symbol_block
; sblk
; sblk
= sblk
->next
)
2057 for (i
= 0; i
< lim
; i
++)
2058 if (!XMARKBIT (sblk
->symbols
[i
].plist
))
2060 *(struct Lisp_Symbol
**)&sblk
->symbols
[i
].value
= symbol_free_list
;
2061 symbol_free_list
= &sblk
->symbols
[i
];
2067 sblk
->symbols
[i
].name
2068 = XSTRING (*(Lisp_Object
*) &sblk
->symbols
[i
].name
);
2069 XUNMARK (sblk
->symbols
[i
].plist
);
2071 lim
= SYMBOL_BLOCK_SIZE
;
2073 total_symbols
= num_used
;
2074 total_free_symbols
= num_free
;
2078 /* Put all unmarked markers on free list.
2079 Dechain each one first from the buffer it points into,
2080 but only if it's a real marker. */
2082 register struct marker_block
*mblk
;
2083 register int lim
= marker_block_index
;
2084 register int num_free
= 0, num_used
= 0;
2086 marker_free_list
= 0;
2088 for (mblk
= marker_block
; mblk
; mblk
= mblk
->next
)
2091 EMACS_INT already_free
= -1;
2093 for (i
= 0; i
< lim
; i
++)
2095 Lisp_Object
*markword
;
2096 switch (mblk
->markers
[i
].u_marker
.type
)
2098 case Lisp_Misc_Marker
:
2099 markword
= &mblk
->markers
[i
].u_marker
.chain
;
2101 case Lisp_Misc_Buffer_Local_Value
:
2102 case Lisp_Misc_Some_Buffer_Local_Value
:
2103 markword
= &mblk
->markers
[i
].u_buffer_local_value
.car
;
2105 case Lisp_Misc_Overlay
:
2106 markword
= &mblk
->markers
[i
].u_overlay
.plist
;
2108 case Lisp_Misc_Free
:
2109 /* If the object was already free, keep it
2110 on the free list. */
2111 markword
= &already_free
;
2117 if (markword
&& !XMARKBIT (*markword
))
2120 if (mblk
->markers
[i
].u_marker
.type
== Lisp_Misc_Marker
)
2122 /* tem1 avoids Sun compiler bug */
2123 struct Lisp_Marker
*tem1
= &mblk
->markers
[i
].u_marker
;
2124 XSETMARKER (tem
, tem1
);
2125 unchain_marker (tem
);
2127 /* Set the type of the freed object to Lisp_Misc_Free.
2128 We could leave the type alone, since nobody checks it,
2129 but this might catch bugs faster. */
2130 mblk
->markers
[i
].u_marker
.type
= Lisp_Misc_Free
;
2131 mblk
->markers
[i
].u_free
.chain
= marker_free_list
;
2132 marker_free_list
= &mblk
->markers
[i
];
2139 XUNMARK (*markword
);
2142 lim
= MARKER_BLOCK_SIZE
;
2145 total_markers
= num_used
;
2146 total_free_markers
= num_free
;
2149 /* Free all unmarked buffers */
2151 register struct buffer
*buffer
= all_buffers
, *prev
= 0, *next
;
2154 if (!XMARKBIT (buffer
->name
))
2157 prev
->next
= buffer
->next
;
2159 all_buffers
= buffer
->next
;
2160 next
= buffer
->next
;
2166 XUNMARK (buffer
->name
);
2167 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer
));
2170 /* Each `struct Lisp_String *' was turned into a Lisp_Object
2171 for purposes of marking and relocation.
2172 Turn them back into C pointers now. */
2173 buffer
->upcase_table
2174 = XSTRING (*(Lisp_Object
*)&buffer
->upcase_table
);
2175 buffer
->downcase_table
2176 = XSTRING (*(Lisp_Object
*)&buffer
->downcase_table
);
2178 = XSTRING (*(Lisp_Object
*)&buffer
->sort_table
);
2179 buffer
->folding_sort_table
2180 = XSTRING (*(Lisp_Object
*)&buffer
->folding_sort_table
);
2183 prev
= buffer
, buffer
= buffer
->next
;
2187 #endif /* standalone */
2189 /* Free all unmarked vectors */
2191 register struct Lisp_Vector
*vector
= all_vectors
, *prev
= 0, *next
;
2192 total_vector_size
= 0;
2195 if (!(vector
->size
& ARRAY_MARK_FLAG
))
2198 prev
->next
= vector
->next
;
2200 all_vectors
= vector
->next
;
2201 next
= vector
->next
;
2207 vector
->size
&= ~ARRAY_MARK_FLAG
;
2208 if (vector
->size
& PSEUDOVECTOR_FLAG
)
2209 total_vector_size
+= (PSEUDOVECTOR_SIZE_MASK
& vector
->size
);
2211 total_vector_size
+= vector
->size
;
2212 prev
= vector
, vector
= vector
->next
;
2216 /* Free all "large strings" not marked with ARRAY_MARK_FLAG. */
2218 register struct string_block
*sb
= large_string_blocks
, *prev
= 0, *next
;
2219 struct Lisp_String
*s
;
2223 s
= (struct Lisp_String
*) &sb
->chars
[0];
2224 if (s
->size
& ARRAY_MARK_FLAG
)
2226 ((struct Lisp_String
*)(&sb
->chars
[0]))->size
2227 &= ~ARRAY_MARK_FLAG
& ~MARKBIT
;
2228 UNMARK_BALANCE_INTERVALS (s
->intervals
);
2229 total_string_size
+= ((struct Lisp_String
*)(&sb
->chars
[0]))->size
;
2230 prev
= sb
, sb
= sb
->next
;
2235 prev
->next
= sb
->next
;
2237 large_string_blocks
= sb
->next
;
2246 /* Compactify strings, relocate references, and free empty string blocks. */
2251 /* String block of old strings we are scanning. */
2252 register struct string_block
*from_sb
;
2253 /* A preceding string block (or maybe the same one)
2254 where we are copying the still-live strings to. */
2255 register struct string_block
*to_sb
;
2259 to_sb
= first_string_block
;
2262 /* Scan each existing string block sequentially, string by string. */
2263 for (from_sb
= first_string_block
; from_sb
; from_sb
= from_sb
->next
)
2266 /* POS is the index of the next string in the block. */
2267 while (pos
< from_sb
->pos
)
2269 register struct Lisp_String
*nextstr
2270 = (struct Lisp_String
*) &from_sb
->chars
[pos
];
2272 register struct Lisp_String
*newaddr
;
2273 register EMACS_INT size
= nextstr
->size
;
2275 /* NEXTSTR is the old address of the next string.
2276 Just skip it if it isn't marked. */
2277 if (((EMACS_UINT
) size
& ~DONT_COPY_FLAG
) > STRING_BLOCK_SIZE
)
2279 /* It is marked, so its size field is really a chain of refs.
2280 Find the end of the chain, where the actual size lives. */
2281 while (((EMACS_UINT
) size
& ~DONT_COPY_FLAG
) > STRING_BLOCK_SIZE
)
2283 if (size
& DONT_COPY_FLAG
)
2284 size
^= MARKBIT
| DONT_COPY_FLAG
;
2285 size
= *(EMACS_INT
*)size
& ~MARKBIT
;
2288 total_string_size
+= size
;
2290 /* If it won't fit in TO_SB, close it out,
2291 and move to the next sb. Keep doing so until
2292 TO_SB reaches a large enough, empty enough string block.
2293 We know that TO_SB cannot advance past FROM_SB here
2294 since FROM_SB is large enough to contain this string.
2295 Any string blocks skipped here
2296 will be patched out and freed later. */
2297 while (to_pos
+ STRING_FULLSIZE (size
)
2298 > max (to_sb
->pos
, STRING_BLOCK_SIZE
))
2300 to_sb
->pos
= to_pos
;
2301 to_sb
= to_sb
->next
;
2304 /* Compute new address of this string
2305 and update TO_POS for the space being used. */
2306 newaddr
= (struct Lisp_String
*) &to_sb
->chars
[to_pos
];
2307 to_pos
+= STRING_FULLSIZE (size
);
2309 /* Copy the string itself to the new place. */
2310 if (nextstr
!= newaddr
)
2311 bcopy (nextstr
, newaddr
, size
+ 1 + sizeof (EMACS_INT
)
2312 + INTERVAL_PTR_SIZE
);
2314 /* Go through NEXTSTR's chain of references
2315 and make each slot in the chain point to
2316 the new address of this string. */
2317 size
= newaddr
->size
;
2318 while (((EMACS_UINT
) size
& ~DONT_COPY_FLAG
) > STRING_BLOCK_SIZE
)
2320 register Lisp_Object
*objptr
;
2321 if (size
& DONT_COPY_FLAG
)
2322 size
^= MARKBIT
| DONT_COPY_FLAG
;
2323 objptr
= (Lisp_Object
*)size
;
2325 size
= XFASTINT (*objptr
) & ~MARKBIT
;
2326 if (XMARKBIT (*objptr
))
2328 XSETSTRING (*objptr
, newaddr
);
2332 XSETSTRING (*objptr
, newaddr
);
2334 /* Store the actual size in the size field. */
2335 newaddr
->size
= size
;
2337 #ifdef USE_TEXT_PROPERTIES
2338 /* Now that the string has been relocated, rebalance its
2339 interval tree, and update the tree's parent pointer. */
2340 if (! NULL_INTERVAL_P (newaddr
->intervals
))
2342 UNMARK_BALANCE_INTERVALS (newaddr
->intervals
);
2343 XSETSTRING (* (Lisp_Object
*) &newaddr
->intervals
->parent
,
2346 #endif /* USE_TEXT_PROPERTIES */
2348 pos
+= STRING_FULLSIZE (size
);
2352 /* Close out the last string block still used and free any that follow. */
2353 to_sb
->pos
= to_pos
;
2354 current_string_block
= to_sb
;
2356 from_sb
= to_sb
->next
;
2360 to_sb
= from_sb
->next
;
2365 /* Free any empty string blocks further back in the chain.
2366 This loop will never free first_string_block, but it is very
2367 unlikely that that one will become empty, so why bother checking? */
2369 from_sb
= first_string_block
;
2370 while (to_sb
= from_sb
->next
)
2372 if (to_sb
->pos
== 0)
2374 if (from_sb
->next
= to_sb
->next
)
2375 from_sb
->next
->prev
= from_sb
;
2383 /* Debugging aids. */
2385 DEFUN ("memory-limit", Fmemory_limit
, Smemory_limit
, 0, 0, 0,
2386 "Return the address of the last byte Emacs has allocated, divided by 1024.\n\
2387 This may be helpful in debugging Emacs's memory usage.\n\
2388 We divide the value by 1024 to make sure it fits in a Lisp integer.")
2393 XSETINT (end
, (EMACS_INT
) sbrk (0) / 1024);
2399 /* Initialization */
2403 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
2406 pure_size
= PURESIZE
;
2409 ignore_warnings
= 1;
2414 #ifdef LISP_FLOAT_TYPE
2416 #endif /* LISP_FLOAT_TYPE */
2420 malloc_hysteresis
= 32;
2422 malloc_hysteresis
= 0;
2425 spare_memory
= (char *) malloc (SPARE_MEMORY
);
2427 ignore_warnings
= 0;
2430 consing_since_gc
= 0;
2431 gc_cons_threshold
= 100000 * sizeof (Lisp_Object
);
2432 #ifdef VIRT_ADDR_VARIES
2433 malloc_sbrk_unused
= 1<<22; /* A large number */
2434 malloc_sbrk_used
= 100000; /* as reasonable as any number */
2435 #endif /* VIRT_ADDR_VARIES */
2446 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold
,
2447 "*Number of bytes of consing between garbage collections.\n\
2448 Garbage collection can happen automatically once this many bytes have been\n\
2449 allocated since the last garbage collection. All data types count.\n\n\
2450 Garbage collection happens automatically only when `eval' is called.\n\n\
2451 By binding this temporarily to a large number, you can effectively\n\
2452 prevent garbage collection during a part of the program.");
2454 DEFVAR_INT ("pure-bytes-used", &pureptr
,
2455 "Number of bytes of sharable Lisp data allocated so far.");
2458 DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used
,
2459 "Number of bytes of unshared memory allocated in this session.");
2461 DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused
,
2462 "Number of bytes of unshared memory remaining available in this session.");
2465 DEFVAR_LISP ("purify-flag", &Vpurify_flag
,
2466 "Non-nil means loading Lisp code in order to dump an executable.\n\
2467 This means that certain objects should be allocated in shared (pure) space.");
2469 DEFVAR_INT ("undo-limit", &undo_limit
,
2470 "Keep no more undo information once it exceeds this size.\n\
2471 This limit is applied when garbage collection happens.\n\
2472 The size is counted as the number of bytes occupied,\n\
2473 which includes both saved text and other data.");
2476 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit
,
2477 "Don't keep more than this much size of undo information.\n\
2478 A command which pushes past this size is itself forgotten.\n\
2479 This limit is applied when garbage collection happens.\n\
2480 The size is counted as the number of bytes occupied,\n\
2481 which includes both saved text and other data.");
2482 undo_strong_limit
= 30000;
2484 /* We build this in advance because if we wait until we need it, we might
2485 not be able to allocate the memory to hold it. */
2487 = Fcons (Qerror
, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil
));
2488 staticpro (&memory_signal_data
);
2490 staticpro (&Qgc_cons_threshold
);
2491 Qgc_cons_threshold
= intern ("gc-cons-threshold");
2496 defsubr (&Smake_byte_code
);
2497 defsubr (&Smake_list
);
2498 defsubr (&Smake_vector
);
2499 defsubr (&Smake_string
);
2500 defsubr (&Smake_symbol
);
2501 defsubr (&Smake_marker
);
2502 defsubr (&Spurecopy
);
2503 defsubr (&Sgarbage_collect
);
2504 defsubr (&Smemory_limit
);