#endif /* not DOUG_LEA_MALLOC */
-#if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD)
+#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
+#ifdef HAVE_GTK_AND_PTHREAD
/* When GTK uses the file chooser dialog, different backends can be loaded
dynamically. One such a backend is the Gnome VFS backend that gets loaded
} \
while (0)
-#else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
+#else /* ! defined HAVE_GTK_AND_PTHREAD */
#define BLOCK_INPUT_ALLOC BLOCK_INPUT
#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
-#endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
-
-/* Value of _bytes_used, when spare_memory was freed. */
-
-static __malloc_size_t bytes_used_when_full;
+#endif /* ! defined HAVE_GTK_AND_PTHREAD */
+#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
#define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG)
#define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0)
-/* Value is the number of bytes/chars of S, a pointer to a struct
- Lisp_String. This must be used instead of STRING_BYTES (S) or
- S->size during GC, because S->size contains the mark bit for
+/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
+ Be careful during GC, because S->size contains the mark bit for
strings. */
#define GC_STRING_BYTES(S) (STRING_BYTES (S))
-#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG)
/* Global variables. */
struct emacs_globals globals;
static char *spare_memory[7];
+#ifndef SYSTEM_MALLOC
/* Amount of spare memory to keep in large reserve block. */
#define SPARE_MEMORY (1 << 14)
+#endif
/* Number of extra blocks malloc should get when it needs more core. */
remapping on more recent systems because this is less important
nowadays than in the days of small memories and timesharing. */
+#ifndef VIRT_ADDR_VARIES
+static
+#endif
EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
#define PUREBEG (char *) pure
/* Buffer in which we save a copy of the C stack at each GC. */
+#if MAX_SAVE_STACK > 0
static char *stack_copy;
-static int stack_copy_size;
+static size_t stack_copy_size;
+#endif
/* Non-zero means ignore malloc warnings. Set during initialization.
Currently not used. */
static int ignore_warnings;
-Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
+static Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qchar_table_extra_slots;
/* Hook run after GC has finished. */
-Lisp_Object Qpost_gc_hook;
+static Lisp_Object Qpost_gc_hook;
static void mark_buffer (Lisp_Object);
static void mark_terminals (void);
-extern void mark_kboards (void);
-extern void mark_ttys (void);
-extern void mark_backtrace (void);
static void gc_sweep (void);
static void mark_glyph_matrix (struct glyph_matrix *);
static void mark_face_cache (struct face_cache *);
-#ifdef HAVE_WINDOW_SYSTEM
-extern void mark_fringe_data (void);
-#endif /* HAVE_WINDOW_SYSTEM */
-
+#if !defined REL_ALLOC || defined SYSTEM_MALLOC
+static void refill_memory_reserve (void);
+#endif
static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
static void sweep_strings (void);
-
-extern int message_enable_multibyte;
+static void free_misc (Lisp_Object);
/* When scanning the C stack for live Lisp objects, Emacs keeps track
of what memory allocated via lisp_malloc is intended for what
intern ("emergency"));
pending_malloc_warning = 0;
}
-
-
-#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().uordblks)
-#else
-# define BYTES_USED _bytes_used
-#endif
\f
/* Called if we can't allocate relocatable space for a buffer. */
/* Like malloc, but wraps allocated block with header and trailer. */
POINTER_TYPE *
-overrun_check_malloc (size)
- size_t size;
+overrun_check_malloc (size_t size)
{
register unsigned char *val;
size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
with header and trailer. */
POINTER_TYPE *
-overrun_check_realloc (block, size)
- POINTER_TYPE *block;
- size_t size;
+overrun_check_realloc (POINTER_TYPE *block, size_t size)
{
- register unsigned char *val = (unsigned char *)block;
+ register unsigned char *val = (unsigned char *) block;
size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
if (val
/* Like free, but checks block for overrun. */
void
-overrun_check_free (block)
- POINTER_TYPE *block;
+overrun_check_free (POINTER_TYPE *block)
{
- unsigned char *val = (unsigned char *)block;
+ unsigned char *val = (unsigned char *) block;
++check_depth;
if (val
static void * (*old_realloc_hook) (void *, size_t, const void*);
static void (*old_free_hook) (void*, const void*);
+#ifdef DOUG_LEA_MALLOC
+# define BYTES_USED (mallinfo ().uordblks)
+#else
+# define BYTES_USED _bytes_used
+#endif
+
static __malloc_size_t bytes_used_when_reconsidered;
+/* Value of _bytes_used, when spare_memory was freed. */
+
+static __malloc_size_t bytes_used_when_full;
+
/* This function is used as the hook for free to call. */
static void
/* List of free intervals. */
-INTERVAL interval_free_list;
+static INTERVAL interval_free_list;
/* Total number of interval blocks now in use. */
register Lisp_Object val;
val = make_uninit_string (length);
memcpy (SDATA (val), contents, length);
- STRING_SET_UNIBYTE (val);
return val;
}
/* Current float_block. */
-struct float_block *float_block;
+static struct float_block *float_block;
/* Index of first unused Lisp_Float in the current float_block. */
-int float_block_index;
+static int float_block_index;
/* Total number of float blocks now in use. */
-int n_float_blocks;
+static int n_float_blocks;
/* Free-list of Lisp_Floats. */
-struct Lisp_Float *float_free_list;
+static struct Lisp_Float *float_free_list;
/* Initialize float allocation. */
/* Current cons_block. */
-struct cons_block *cons_block;
+static struct cons_block *cons_block;
/* Index of first unused Lisp_Cons in the current block. */
-int cons_block_index;
+static int cons_block_index;
/* Free-list of Lisp_Cons structures. */
-struct Lisp_Cons *cons_free_list;
+static struct Lisp_Cons *cons_free_list;
/* Total number of cons blocks now in use. */
return val;
}
+#ifdef GC_CHECK_CONS_LIST
/* Get an error now if there's any junk in the cons free list. */
void
check_cons_list (void)
{
-#ifdef GC_CHECK_CONS_LIST
struct Lisp_Cons *tail = cons_free_list;
while (tail)
tail = tail->u.chain;
-#endif
}
+#endif
/* Make a list of 1, 2, 3, 4 or 5 specified objects. */
doc: /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (list &rest OBJECTS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
register Lisp_Object val;
val = Qnil;
{
Lisp_Object vector;
register EMACS_INT sizei;
- register EMACS_INT index;
+ register EMACS_INT i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
sizei = XFASTINT (length);
p = allocate_vector (sizei);
- for (index = 0; index < sizei; index++)
- p->contents[index] = init;
+ for (i = 0; i < sizei; i++)
+ p->contents[i] = init;
XSETVECTOR (vector, p);
return vector;
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */)
- (register int nargs, Lisp_Object *args)
+ (register size_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register size_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
- for (index = 0; index < nargs; index++)
- p->contents[index] = args[index];
+ for (i = 0; i < nargs; i++)
+ p->contents[i] = args[i];
return val;
}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
-The arguments should be the arglist, bytecode-string, constant vector,
-stack size, (optional) doc string, and (optional) interactive spec.
+The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
+vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
+and (optional) INTERACTIVE-SPEC.
The first four arguments are required; at most six have any
significance.
+The ARGLIST can be either like the one of `lambda', in which case the arguments
+will be dynamically bound before executing the byte code, or it can be an
+integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
+minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
+of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
+argument to catch the left-over arguments. If such an integer is used, the
+arguments will not be dynamically bound but will be instead pushed on the
+stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
- (register int nargs, Lisp_Object *args)
+ (register size_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register size_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
args[1] = Fstring_as_unibyte (args[1]);
p = XVECTOR (val);
- for (index = 0; index < nargs; index++)
+ for (i = 0; i < nargs; i++)
{
if (!NILP (Vpurify_flag))
- args[index] = Fpurecopy (args[index]);
- p->contents[index] = args[index];
+ args[i] = Fpurecopy (args[i]);
+ p->contents[i] = args[i];
}
XSETPVECTYPE (p, PVEC_COMPILED);
XSETCOMPILED (val, p);
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
+ p->declared_special = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
return val;
/* Free a Lisp_Misc object */
-void
+static void
free_misc (Lisp_Object misc)
{
XMISCTYPE (misc) = Lisp_Misc_Free;
/* Record the space now used. When it decreases substantially,
we can refill the memory reserve. */
-#ifndef SYSTEM_MALLOC
+#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
bytes_used_when_full = BYTES_USED;
#endif
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->name));
+ && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
check_gcpros (void)
{
struct gcpro *p;
- int i;
+ size_t i;
for (p = gcprolist; p; p = p->next)
for (i = 0; i < p->nvars; ++i)
mark_stack (void)
{
int i;
- /* jmp_buf may not be aligned enough on darwin-ppc64 */
- union aligned_jmpbuf {
- Lisp_Object o;
- jmp_buf j;
- } j;
- volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
void *end;
#ifdef HAVE___BUILTIN_UNWIND_INIT
__builtin_unwind_init ();
end = &end;
#else /* not HAVE___BUILTIN_UNWIND_INIT */
+#ifndef GC_SAVE_REGISTERS_ON_STACK
+ /* jmp_buf may not be aligned enough on darwin-ppc64 */
+ union aligned_jmpbuf {
+ Lisp_Object o;
+ jmp_buf j;
+ } j;
+ volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
+#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
/* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
(void)
{
register struct specbinding *bind;
- struct catchtag *catch;
- struct handler *handler;
char stack_top_variable;
- register int i;
+ register size_t i;
int message_p;
Lisp_Object total[8];
int count = SPECPDL_INDEX ();
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
- if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt))
+ if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->name)
+ if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
&& ! nextb->text->inhibit_shrinking)
{
/* If a buffer's gap size is more than 10% of the buffer
#if MAX_SAVE_STACK > 0
if (NILP (Vpurify_flag))
{
- i = &stack_top_variable - stack_bottom;
- if (i < 0) i = -i;
- if (i < MAX_SAVE_STACK)
+ char *stack;
+ size_t stack_size;
+ if (&stack_top_variable < stack_bottom)
+ {
+ stack = &stack_top_variable;
+ stack_size = stack_bottom - &stack_top_variable;
+ }
+ else
+ {
+ stack = stack_bottom;
+ stack_size = &stack_top_variable - stack_bottom;
+ }
+ if (stack_size <= MAX_SAVE_STACK)
{
- if (stack_copy == 0)
- stack_copy = (char *) xmalloc (stack_copy_size = i);
- else if (stack_copy_size < i)
- stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
- if (stack_copy)
+ if (stack_copy_size < stack_size)
{
- if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
- memcpy (stack_copy, stack_bottom, i);
- else
- memcpy (stack_copy, &stack_top_variable, i);
+ stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy_size = stack_size;
}
+ memcpy (stack_copy, stack, stack_size);
}
}
#endif /* MAX_SAVE_STACK > 0 */
for (i = 0; i < tail->nvars; i++)
mark_object (tail->var[i]);
}
-#endif
-
mark_byte_stack ();
+ {
+ struct catchtag *catch;
+ struct handler *handler;
+
for (catch = catchlist; catch; catch = catch->next)
{
mark_object (catch->tag);
mark_object (handler->handler);
mark_object (handler->var);
}
+ }
mark_backtrace ();
+#endif
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->undo_list, Qt))
+ if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
{
Lisp_Object tail, prev;
- tail = nextb->undo_list;
+ tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
prev = Qnil;
while (CONSP (tail))
{
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
- nextb->undo_list = tail = XCDR (tail);
+ nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
else
{
tail = XCDR (tail);
}
/* Now that we have stripped the elements that need not be in the
undo_list any more, we can finally mark the list. */
- mark_object (nextb->undo_list);
+ mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
nextb = nextb->next;
}
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- EMACS_INT total = 0;
-
- total += total_conses * sizeof (struct Lisp_Cons);
- total += total_symbols * sizeof (struct Lisp_Symbol);
- total += total_markers * sizeof (union Lisp_Misc);
- total += total_string_size;
- total += total_vector_size * sizeof (Lisp_Object);
- total += total_floats * sizeof (struct Lisp_Float);
- total += total_intervals * sizeof (struct interval);
- total += total_strings * sizeof (struct Lisp_String);
-
- gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
+ EMACS_INT tot = 0;
+
+ tot += total_conses * sizeof (struct Lisp_Cons);
+ tot += total_symbols * sizeof (struct Lisp_Symbol);
+ tot += total_markers * sizeof (union Lisp_Misc);
+ tot += total_string_size;
+ tot += total_vector_size * sizeof (Lisp_Object);
+ tot += total_floats * sizeof (struct Lisp_Float);
+ tot += total_intervals * sizeof (struct interval);
+ tot += total_strings * sizeof (struct Lisp_String);
+
+ gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
}
else
gc_relative_threshold = 0;
if (!NILP (Vpost_gc_hook))
{
- int count = inhibit_garbage_collection ();
+ int gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
- unbind_to (count, Qnil);
+ unbind_to (gc_count, Qnil);
}
/* Accumulate statistics. */
#define LAST_MARKED_SIZE 500
static Lisp_Object last_marked[LAST_MARKED_SIZE];
-int last_marked_index;
+static int last_marked_index;
/* For debugging--call abort when we cdr down this many
links of a list, in mark_object. In debugging,
the call to abort will hit a breakpoint.
Normally this is zero and the check never goes off. */
-static int mark_object_loop_halt;
+static size_t mark_object_loop_halt;
static void
mark_vectorlike (struct Lisp_Vector *ptr)
void *po;
struct mem_node *m;
#endif
- int cdr_count = 0;
+ size_t cdr_count = 0;
loop:
#else /* not GC_CHECK_MARKED_OBJECTS */
-#define CHECK_ALLOCATED() (void) 0
#define CHECK_LIVE(LIVEP) (void) 0
#define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
- for (ptr = &buffer->name;
+ for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
mark_object (*ptr);
{
Lisp_Object end;
- XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
+ XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024);
return end;
}
return Flist (8, consed);
}
+#ifdef ENABLE_CHECKING
int suppress_checking;
void
file, line, msg);
abort ();
}
+#endif
\f
/* Initialization */
HCoop / bpt / emacs.git / blobdiff