/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 88, 93, 94, 95, 97 Free Software Foundation, Inc.
This file is part of GNU Emacs.
extern char *sbrk ();
+#ifdef DOUG_LEA_MALLOC
+#include <malloc.h>
+#define __malloc_size_t int
+#else
/* The following come from gmalloc.c. */
#if defined (__STDC__) && __STDC__
#endif
extern __malloc_size_t _bytes_used;
extern int __malloc_extra_blocks;
+#endif /* !defined(DOUG_LEA_MALLOC) */
+
+extern Lisp_Object Vhistory_length;
#define max(A,B) ((A) > (B) ? (A) : (B))
#define min(A,B) ((A) < (B) ? (A) : (B))
internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
}
+#ifdef DOUG_LEA_MALLOC
+# define BYTES_USED (mallinfo ().arena)
+#else
+# define BYTES_USED _bytes_used
+#endif
+
/* Called if malloc returns zero */
memory_full ()
{
#ifndef SYSTEM_MALLOC
- bytes_used_when_full = _bytes_used;
+ bytes_used_when_full = BYTES_USED;
#endif
/* The first time we get here, free the spare memory. */
/* This used to call error, but if we've run out of memory, we could get
infinite recursion trying to build the string. */
while (1)
- Fsignal (Qerror, memory_signal_data);
+ Fsignal (Qnil, memory_signal_data);
}
/* Called if we can't allocate relocatable space for a buffer. */
The code here is correct as long as SPARE_MEMORY
is substantially larger than the block size malloc uses. */
&& (bytes_used_when_full
- > _bytes_used + max (malloc_hysteresis, 4) * SPARE_MEMORY))
+ > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY))
spare_memory = (char *) malloc (SPARE_MEMORY);
__free_hook = emacs_blocked_free;
BLOCK_INPUT;
__malloc_hook = old_malloc_hook;
- __malloc_extra_blocks = malloc_hysteresis;
+#ifdef DOUG_LEA_MALLOC
+ mallopt (M_TOP_PAD, malloc_hysteresis * 4096);
+#else
+ __malloc_extra_blocks = malloc_hysteresis;
+#endif
value = (void *) malloc (size);
__malloc_hook = emacs_blocked_malloc;
UNBLOCK_INPUT;
#define MARK_INTERVAL_TREE(i) \
do { \
if (!NULL_INTERVAL_P (i) \
- && ! XMARKBIT ((Lisp_Object) i->parent)) \
+ && ! XMARKBIT (*(Lisp_Object *) &i->parent)) \
mark_interval_tree (i); \
} while (0)
struct Lisp_Vector *p;
allocating_for_lisp = 1;
+#ifdef DOUG_LEA_MALLOC
+ /* Prevent mmap'ing the chunk (which is potentially very large). */
+ mallopt (M_MMAP_MAX, 0);
+#endif
p = (struct Lisp_Vector *)xmalloc (sizeof (struct Lisp_Vector)
+ (len - 1) * sizeof (Lisp_Object));
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, 64);
+#endif
allocating_for_lisp = 0;
VALIDATE_LISP_STORAGE (p, 0);
consing_since_gc += (sizeof (struct Lisp_Vector)
DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
"Return a newly created char-table, with purpose PURPOSE.\n\
Each element is initialized to INIT, which defaults to nil.\n\
-PURPOSE should be a symbol which has a `char-table-extra-slot' property.\n\
+PURPOSE should be a symbol which has a `char-table-extra-slots' property.\n\
The property's value should be an integer between 0 and 10.")
(purpose, init)
register Lisp_Object purpose, init;
/* Add 2 to the size for the defalt and parent slots. */
vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
init);
+ XCHAR_TABLE (vector)->top = Qt;
XCHAR_TABLE (vector)->parent = Qnil;
XCHAR_TABLE (vector)->purpose = purpose;
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
+/* Return a newly created sub char table with default value DEFALT.
+ Since a sub char table does not appear as a top level Emacs Lisp
+ object, we don't need a Lisp interface to make it. */
+
+Lisp_Object
+make_sub_char_table (defalt)
+ Lisp_Object defalt;
+{
+ Lisp_Object vector
+ = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil);
+ XCHAR_TABLE (vector)->top = Qnil;
+ XCHAR_TABLE (vector)->defalt = defalt;
+ XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
+ return vector;
+}
+
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
"Return a newly created vector with specified arguments as elements.\n\
Any number of arguments, even zero arguments, are allowed.")
XSETFASTINT (len, nargs);
if (!NILP (Vpurify_flag))
- val = make_pure_vector (len);
+ val = make_pure_vector ((EMACS_INT) nargs);
else
val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
- XSETCOMPILED (val, val);
+ XSETCOMPILED (val, p);
return val;
}
\f
}
p = XSYMBOL (val);
p->name = XSTRING (name);
+ p->obarray = Qnil;
p->plist = Qnil;
p->value = Qunbound;
p->function = Qunbound;
}
DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
- "Return a newly created bitstring of length LENGTH, with INIT as each element.\n\
-Both LENGTH and INIT must be numbers. INIT matters only in whether it is t or nil.")
+ "Return a new bool-vector of length LENGTH, using INIT for as each element.\n\
+LENGTH must be a number. INIT matters only in whether it is t or nil.")
(length, init)
Lisp_Object length, init;
{
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
length_in_chars = length_in_elts * sizeof (EMACS_INT);
- val = Fmake_vector (make_number (length_in_elts), Qnil);
+ /* We must allocate one more elements than LENGTH_IN_ELTS for the
+ slot `size' of the struct Lisp_Bool_Vector. */
+ val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
p = XBOOL_VECTOR (val);
/* Get rid of any bits that would cause confusion. */
p->vector_size = 0;
{
register struct string_block *new;
allocating_for_lisp = 1;
+#ifdef DOUG_LEA_MALLOC
+ /* Prevent mmap'ing the chunk (which is potentially very large). */
+ mallopt (M_MMAP_MAX, 0);
+#endif
new = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize);
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, 64);
+#endif
allocating_for_lisp = 0;
VALIDATE_LISP_STORAGE (new, 0);
consing_since_gc += sizeof (struct string_block_head) + fullsize;
{
Lisp_Object result;
- result = Fmake_string (nargs, make_number (0));
+ result = Fmake_string (make_number (nargs), make_number (0));
for (i = 0; i < nargs; i++)
{
XSTRING (result)->data[i] = XINT (args[i]);
size = XVECTOR (obj)->size;
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
- vec = XVECTOR (make_pure_vector (size));
+ vec = XVECTOR (make_pure_vector ((EMACS_INT) size));
for (i = 0; i < size; i++)
vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
if (COMPILEDP (obj))
if (garbage_collection_messages)
message1_nolog ("Garbage collecting...");
- /* Don't keep command history around forever */
- tem = Fnthcdr (make_number (30), Vcommand_history);
- if (CONSP (tem))
- XCONS (tem)->cdr = Qnil;
+ /* Don't keep command history around forever. */
+ if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
+ {
+ tem = Fnthcdr (Vhistory_length, Vcommand_history);
+ if (CONSP (tem))
+ XCONS (tem)->cdr = Qnil;
+ }
/* Likewise for undo information. */
{
gc_in_progress = 1;
-/* clear_marks (); */
+ /* clear_marks (); */
/* In each "large string", set the MARKBIT of the size field.
That enables mark_object to recognize them. */
XUNMARK (buffer_defaults.name);
XUNMARK (buffer_local_symbols.name);
-/* clear_marks (); */
+ /* clear_marks (); */
gc_in_progress = 0;
consing_since_gc = 0;
mark_object (&ptr->face_alist);
mark_object (&ptr->menu_bar_vector);
mark_object (&ptr->buffer_predicate);
+ mark_object (&ptr->buffer_list);
}
else if (GC_BOOL_VECTOR_P (obj))
{
case Lisp_Misc_Free:
/* If the object was already free, keep it
on the free list. */
- markword = &already_free;
+ markword = (Lisp_Object *) &already_free;
break;
default:
markword = 0;
#endif
all_vectors = 0;
ignore_warnings = 1;
+#ifdef DOUG_LEA_MALLOC
+ mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
+ mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
+ mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
+#endif
init_strings ();
init_cons ();
init_symbol ();