/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
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
/* Value is non-zero if P points into pure space. */
#define PURE_POINTER_P(P) \
- (((PNTR_COMPARISON_TYPE) (P) \
- < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \
- && ((PNTR_COMPARISON_TYPE) (P) \
- >= (PNTR_COMPARISON_TYPE) purebeg))
+ ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
/* Index in pure at which next pure Lisp object will be allocated.. */
-static EMACS_INT pure_bytes_used_lisp;
+static ptrdiff_t pure_bytes_used_lisp;
/* Number of bytes allocated for non-Lisp objects in pure storage. */
-static EMACS_INT pure_bytes_used_non_lisp;
+static ptrdiff_t pure_bytes_used_non_lisp;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
static void free_large_strings (void);
static void sweep_strings (void);
static void free_misc (Lisp_Object);
+extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
/* When scanning the C stack for live Lisp objects, Emacs keeps track
of what memory allocated via lisp_malloc is intended for what
on free lists recognizable in O(1). */
static Lisp_Object Vdead;
+#define DEADP(x) EQ (x, Vdead)
#ifdef GC_MALLOC_CHECK
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
+static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
static void lisp_free (POINTER_TYPE *);
static void mark_stack (void);
static int live_vector_p (struct mem_node *, void *);
static int live_float_p (struct mem_node *, void *);
static int live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
-static void mark_memory (void *, void *, int);
+static void mark_memory (void *, void *);
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
+#ifndef DEADP
+# define DEADP(x) 0
+#endif
+
/* Recording what needs to be marked for gc. */
struct gcpro *gcprolist;
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (EMACS_INT nbytes)
+buffer_memory_full (ptrdiff_t nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
/* Check for overrun in malloc'ed buffers by wrapping a header and trailer
around each block.
- The header consists of 16 fixed bytes followed by sizeof (size_t) bytes
- containing the original block size in little-endian order,
- while the trailer consists of 16 fixed bytes.
+ The header consists of XMALLOC_OVERRUN_CHECK_SIZE fixed bytes
+ followed by XMALLOC_OVERRUN_SIZE_SIZE bytes containing the original
+ block size in little-endian order. The trailer consists of
+ XMALLOC_OVERRUN_CHECK_SIZE fixed bytes.
The header is used to detect whether this block has been allocated
- through these functions -- as it seems that some low-level libc
- functions may bypass the malloc hooks.
-*/
-
+ through these functions, as some low-level libc functions may
+ bypass the malloc hooks. */
#define XMALLOC_OVERRUN_CHECK_SIZE 16
#define XMALLOC_OVERRUN_CHECK_OVERHEAD \
- (2 * XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t))
+ (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE)
+
+/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
+ hold a size_t value and (2) the header size is a multiple of the
+ alignment that Emacs needs for C types and for USE_LSB_TAG. */
+#define XMALLOC_BASE_ALIGNMENT \
+ offsetof ( \
+ struct { \
+ union { long double d; intmax_t i; void *p; } u; \
+ char c; \
+ }, \
+ c)
+#ifdef USE_LSB_TAG
+/* A common multiple of the positive integers A and B. Ideally this
+ would be the least common multiple, but there's no way to do that
+ as a constant expression in C, so do the best that we can easily do. */
+# define COMMON_MULTIPLE(a, b) \
+ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
+# define XMALLOC_HEADER_ALIGNMENT \
+ COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT)
+#else
+# define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT
+#endif
+#define XMALLOC_OVERRUN_SIZE_SIZE \
+ (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t) \
+ + XMALLOC_HEADER_ALIGNMENT - 1) \
+ / XMALLOC_HEADER_ALIGNMENT * XMALLOC_HEADER_ALIGNMENT) \
+ - XMALLOC_OVERRUN_CHECK_SIZE)
static char const xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE] =
{ '\x9a', '\x9b', '\xae', '\xaf',
xmalloc_put_size (unsigned char *ptr, size_t size)
{
int i;
- for (i = 0; i < sizeof (size_t); i++)
+ for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
{
- *--ptr = size & (1 << CHAR_BIT) - 1;
+ *--ptr = size & ((1 << CHAR_BIT) - 1);
size >>= CHAR_BIT;
}
}
{
size_t size = 0;
int i;
- ptr -= sizeof (size_t);
- for (i = 0; i < sizeof (size_t); i++)
+ ptr -= XMALLOC_OVERRUN_SIZE_SIZE;
+ for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
{
size <<= CHAR_BIT;
size += *ptr++;
if (val && check_depth == 1)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
- val += XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t);
+ val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
xmalloc_put_size (val, size);
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
if (val
&& check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
- val - XMALLOC_OVERRUN_CHECK_SIZE - sizeof (size_t),
+ val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
{
size_t osize = xmalloc_get_size (val);
XMALLOC_OVERRUN_CHECK_SIZE))
abort ();
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
- val -= XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t);
- memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t));
+ val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
+ memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
}
val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
if (val && check_depth == 1)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
- val += XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t);
+ val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
xmalloc_put_size (val, size);
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
if (val
&& check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
- val - XMALLOC_OVERRUN_CHECK_SIZE - sizeof (size_t),
+ val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
{
size_t osize = xmalloc_get_size (val);
XMALLOC_OVERRUN_CHECK_SIZE))
abort ();
#ifdef XMALLOC_CLEAR_FREE_MEMORY
- val -= XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t);
+ val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
#else
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
- val -= XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t);
- memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t));
+ val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
+ memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
#endif
}
/* Like malloc but used for allocating Lisp data. NBYTES is the
number of bytes to allocate, TYPE describes the intended use of the
- allcated memory block (for strings, for conses, ...). */
+ allocated memory block (for strings, for conses, ...). */
#ifndef USE_LSB_TAG
static void *lisp_malloc_loser;
#ifdef DOUG_LEA_MALLOC
pthread_mutexattr_t attr;
- /* GLIBC has a faster way to do this, but lets keep it portable.
+ /* GLIBC has a faster way to do this, but let's keep it portable.
This is according to the Single UNIX Specification. */
pthread_mutexattr_init (&attr);
pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
#ifdef GC_CHECK_STRING_BYTES
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
unsigned char data[1];
#define SDATA_NBYTES(S) (S)->nbytes
unsigned char data[1];
/* When STRING is null. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
} u;
#define SDATA_NBYTES(S) (S)->u.nbytes
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
+ (NBYTES) + 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#else /* not GC_CHECK_STRING_BYTES */
/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
less than the size of that member. The 'max' is not needed when
- SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the
+ SDATA_DATA_OFFSET is a multiple of sizeof (ptrdiff_t), because then the
alignment code reserves enough space. */
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
- + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \
+ + (SDATA_DATA_OFFSET % sizeof (ptrdiff_t) == 0 \
? NBYTES \
- : max (NBYTES, sizeof (EMACS_INT) - 1)) \
+ : max (NBYTES, sizeof (ptrdiff_t) - 1)) \
+ 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
/* Like GC_STRING_BYTES, but with debugging check. */
-EMACS_INT
+ptrdiff_t
string_bytes (struct Lisp_String *s)
{
- EMACS_INT nbytes =
+ ptrdiff_t nbytes =
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
while (s != NULL)
{
if ((uintptr_t) s < 1024)
- abort();
+ abort ();
s = NEXT_FREE_LISP_STRING (s);
}
}
{
struct sdata *data, *old_data;
struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ ptrdiff_t needed, old_nbytes;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- EMACS_INT length_in_chars, length_in_elts;
+ ptrdiff_t length_in_chars;
+ EMACS_INT length_in_elts;
int bits_per_value;
CHECK_NATNUM (length);
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
/* We must allocate one more elements than LENGTH_IN_ELTS for the
slot `size' of the struct Lisp_Bool_Vector. */
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
+ length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
if (length_in_chars)
{
memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, EMACS_INT nbytes)
+make_string (const char *contents, ptrdiff_t nbytes)
{
register Lisp_Object val;
- EMACS_INT nchars, multibyte_nbytes;
+ ptrdiff_t nchars, multibyte_nbytes;
parse_str_as_multibyte ((const unsigned char *) contents, nbytes,
&nchars, &multibyte_nbytes);
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, EMACS_INT length)
+make_unibyte_string (const char *contents, ptrdiff_t length)
{
register Lisp_Object val;
val = make_uninit_string (length);
Lisp_Object
make_multibyte_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_string_from_bytes (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_specified_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
{
register Lisp_Object val;
/ (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
#define GETMARKBIT(block,n) \
- (((block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
- >> ((n) % (sizeof(int) * CHAR_BIT))) \
+ (((block)->gcmarkbits[(n) / (sizeof (int) * CHAR_BIT)] \
+ >> ((n) % (sizeof (int) * CHAR_BIT))) \
& 1)
#define SETMARKBIT(block,n) \
- (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
- |= 1 << ((n) % (sizeof(int) * CHAR_BIT))
+ (block)->gcmarkbits[(n) / (sizeof (int) * CHAR_BIT)] \
+ |= 1 << ((n) % (sizeof (int) * CHAR_BIT))
#define UNSETMARKBIT(block,n) \
- (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
- &= ~(1 << ((n) % (sizeof(int) * CHAR_BIT)))
+ (block)->gcmarkbits[(n) / (sizeof (int) * CHAR_BIT)] \
+ &= ~(1 << ((n) % (sizeof (int) * CHAR_BIT)))
#define FLOAT_BLOCK(fptr) \
((struct float_block *) (((uintptr_t) (fptr)) & ~(BLOCK_ALIGN - 1)))
{
/* Place `floats' at the beginning, to ease up FLOAT_INDEX's job. */
struct Lisp_Float floats[FLOAT_BLOCK_SIZE];
- int gcmarkbits[1 + FLOAT_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
+ int gcmarkbits[1 + FLOAT_BLOCK_SIZE / (sizeof (int) * CHAR_BIT)];
struct float_block *next;
};
{
/* Place `conses' at the beginning, to ease up CONS_INDEX's job. */
struct Lisp_Cons conses[CONS_BLOCK_SIZE];
- int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
+ int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof (int) * CHAR_BIT)];
struct cons_block *next;
};
with room for LEN Lisp_Objects. */
static struct Lisp_Vector *
-allocate_vectorlike (EMACS_INT len)
+allocate_vectorlike (ptrdiff_t len)
{
struct Lisp_Vector *p;
size_t nbytes;
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
+allocate_pseudovector (int memlen, int lisplen, int tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
struct window *
allocate_window (void)
{
- return ALLOCATE_PSEUDOVECTOR(struct window, current_matrix, PVEC_WINDOW);
+ return ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
}
(register Lisp_Object length, Lisp_Object init)
{
Lisp_Object vector;
- register EMACS_INT sizei;
- register EMACS_INT i;
+ register ptrdiff_t sizei;
+ register ptrdiff_t i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
- sizei = XFASTINT (length);
- p = allocate_vector (sizei);
+ p = allocate_vector (XFASTINT (length));
+ sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
p->contents[i] = init;
{
Lisp_Object args[8], zombie_list = Qnil;
EMACS_INT i;
- for (i = 0; i < nzombies; i++)
+ for (i = 0; i < min (MAX_ZOMBIES, nzombies); i++)
zombie_list = Fcons (zombies[i], zombie_list);
args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
args[1] = make_number (ngcs);
break;
case MEM_TYPE_BUFFER:
- if (live_buffer_p (m, p) && !VECTOR_MARKED_P((struct buffer *)p))
+ if (live_buffer_p (m, p) && !VECTOR_MARKED_P ((struct buffer *)p))
XSETVECTOR (obj, p);
break;
}
+/* Alignment of Lisp_Object and pointer values. Use offsetof, as it
+ sometimes returns a smaller alignment than GCC's __alignof__ and
+ mark_memory might miss objects if __alignof__ were used. For
+ example, on x86 with WIDE_EMACS_INT, __alignof__ (Lisp_Object) is 8
+ but GC_LISP_OBJECT_ALIGNMENT should be 4. */
+#ifndef GC_LISP_OBJECT_ALIGNMENT
+# define GC_LISP_OBJECT_ALIGNMENT offsetof (struct {char a; Lisp_Object b;}, b)
+#endif
+#define GC_POINTER_ALIGNMENT offsetof (struct {char a; void *b;}, b)
+
/* Mark Lisp objects referenced from the address range START+OFFSET..END
or END+OFFSET..START. */
static void
-mark_memory (void *start, void *end, int offset)
+mark_memory (void *start, void *end)
{
Lisp_Object *p;
void **pp;
+ int i;
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
nzombies = 0;
}
/* Mark Lisp_Objects. */
- for (p = (Lisp_Object *) ((char *) start + offset); (void *) p < end; ++p)
- mark_maybe_object (*p);
+ for (p = start; (void *) p < end; p++)
+ for (i = 0; i < sizeof *p; i += GC_LISP_OBJECT_ALIGNMENT)
+ mark_maybe_object (*(Lisp_Object *) ((char *) p + i));
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
away. The only reference to the life string is through the
pointer `s'. */
- for (pp = (void **) ((char *) start + offset); (void *) pp < end; ++pp)
- mark_maybe_pointer (*pp);
+ for (pp = start; (void *) pp < end; pp++)
+ for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
+ mark_maybe_pointer (*(void **) ((char *) pp + i));
}
/* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
{
int i;
- fprintf (stderr, "\nZombies kept alive = %"pI":\n", nzombies);
+ fprintf (stderr, "\nZombies kept alive = %"pI"d:\n", nzombies);
for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
{
fprintf (stderr, " %d = ", i);
pass starting at the start of the stack + 2. Likewise, if the
minimal alignment of Lisp_Objects on the stack is 1, four passes
would be necessary, each one starting with one byte more offset
- from the stack start.
-
- The current code assumes by default that Lisp_Objects are aligned
- equally on the stack. */
+ from the stack start. */
static void
mark_stack (void)
{
- int i;
void *end;
#ifdef HAVE___BUILTIN_UNWIND_INIT
/* This assumes that the stack is a contiguous region in memory. If
that's not the case, something has to be done here to iterate
over the stack segments. */
-#ifndef GC_LISP_OBJECT_ALIGNMENT
-#ifdef __GNUC__
-#define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object)
-#else
-#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object)
-#endif
-#endif
- for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
- mark_memory (stack_base, end, i);
+ mark_memory (stack_base, end);
+
/* Allow for marking a secondary stack, like the register stack on the
ia64. */
#ifdef GC_MARK_SECONDARY_STACK
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, EMACS_INT nbytes)
+find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
{
int i;
- EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
- if (pure_bytes_used_non_lisp < nbytes + 1)
+ if (pure_bytes_used_non_lisp <= nbytes)
return NULL;
/* Set up the Boyer-Moore table. */
Lisp_Object
make_pure_string (const char *data,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
{
Lisp_Object string;
struct Lisp_String *s;
{
Lisp_Object string;
struct Lisp_String *s;
- EMACS_INT nchars = strlen (data);
+ ptrdiff_t nchars = strlen (data);
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
s->size = nchars;
pure space. */
Lisp_Object
-make_pure_vector (EMACS_INT len)
+make_pure_vector (ptrdiff_t len)
{
Lisp_Object new;
struct Lisp_Vector *p;
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register EMACS_INT i;
- EMACS_INT size;
+ register ptrdiff_t i;
+ ptrdiff_t size;
size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
/* Temporarily prevent garbage collection. */
-int
+ptrdiff_t
inhibit_garbage_collection (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
ptrdiff_t i;
int message_p;
Lisp_Object total[8];
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
EMACS_TIME t1, t2, t3;
if (abort_on_gc)
if (!NILP (Vpost_gc_hook))
{
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
unbind_to (gc_count, Qnil);
}
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- EMACS_INT size = ptr->header.size;
- EMACS_INT i;
+ ptrdiff_t size = ptr->header.size;
+ ptrdiff_t i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr); /* Else mark it */
return Flist (8, consed);
}
+/* Find at most FIND_MAX symbols which have OBJ as their value or
+ function. This is used in gdbinit's `xwhichsymbols' command. */
+
+Lisp_Object
+which_symbols (Lisp_Object obj, EMACS_INT find_max)
+{
+ struct symbol_block *sblk;
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
+ Lisp_Object found = Qnil;
+
+ if (! DEADP (obj))
+ {
+ for (sblk = symbol_block; sblk; sblk = sblk->next)
+ {
+ struct Lisp_Symbol *sym = sblk->symbols;
+ int bn;
+
+ for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, sym++)
+ {
+ Lisp_Object val;
+ Lisp_Object tem;
+
+ if (sblk == symbol_block && bn >= symbol_block_index)
+ break;
+
+ XSETSYMBOL (tem, sym);
+ val = find_symbol_value (tem);
+ if (EQ (val, obj)
+ || EQ (sym->function, obj)
+ || (!NILP (sym->function)
+ && COMPILEDP (sym->function)
+ && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
+ || (!NILP (val)
+ && COMPILEDP (val)
+ && EQ (AREF (val, COMPILED_BYTECODE), obj)))
+ {
+ found = Fcons (tem, found);
+ if (--find_max == 0)
+ goto out;
+ }
+ }
+ }
+ }
+
+ out:
+ unbind_to (gc_count, Qnil);
+ return found;
+}
+
#ifdef ENABLE_CHECKING
int suppress_checking;
Vgc_cons_percentage = make_float (0.1);
DEFVAR_INT ("pure-bytes-used", pure_bytes_used,
- doc: /* Number of bytes of sharable Lisp data allocated so far. */);
+ doc: /* Number of bytes of shareable Lisp data allocated so far. */);
DEFVAR_INT ("cons-cells-consed", cons_cells_consed,
doc: /* Number of cons cells that have been consed so far. */);
HCoop / bpt / emacs.git / blobdiff