/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
static bool valgrind_p;
#endif
-#ifdef USE_LOCAL_ALLOCATORS
-# if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-# error "Stack-allocated Lisp objects are not compatible with GCPROs"
-# endif
-#endif
-
/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
Doable only if GC_MARK_STACK. */
#if ! GC_MARK_STACK
/* 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 \
- alignof (union { long double d; intmax_t i; void *p; })
+#define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
#if USE_LSB_TAG
# define XMALLOC_HEADER_ALIGNMENT \
return val;
}
-#ifdef USE_LOCAL_ALLOCATORS
-
-/* Initialize the string S from DATA and SIZE. S must be followed by
- SIZE + 1 bytes of memory that can be used. Return S tagged as a
- Lisp object. */
-
-Lisp_Object
-local_string_init (struct Lisp_String *s, char const *data, ptrdiff_t size)
-{
- unsigned char *data_copy = (unsigned char *) (s + 1);
- parse_str_as_multibyte ((unsigned char const *) data,
- size, &s->size, &s->size_byte);
- if (size == s->size || size != s->size_byte)
- {
- s->size = size;
- s->size_byte = -1;
- }
- s->intervals = NULL;
- s->data = data_copy;
- memcpy (data_copy, data, size);
- data_copy[size] = '\0';
- return make_lisp_ptr (s, Lisp_String);
-}
-
-#endif
-
-
-/* Make an unibyte string from LENGTH bytes at CONTENTS. */
+/* Make a unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
make_unibyte_string (const char *contents, ptrdiff_t length)
}
-/* Return an unibyte Lisp_String set up to hold LENGTH characters
+/* Return a unibyte Lisp_String set up to hold LENGTH characters
occupying LENGTH bytes. */
Lisp_Object
static struct Lisp_Vector *
next_vector (struct Lisp_Vector *v)
{
- return XUNTAG (v->contents[0], 0);
+ return XUNTAG (v->contents[0], Lisp_Int0);
}
static void
set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
{
- v->contents[0] = make_lisp_ptr (p, 0);
+ v->contents[0] = make_lisp_ptr (p, Lisp_Int0);
}
/* This value is balanced well enough to avoid too much internal overhead
return vector;
}
-#ifdef USE_LOCAL_ALLOCATORS
-
-/* Initialize V with LENGTH objects each with value INIT,
- and return it tagged as a Lisp Object. */
-
-INLINE Lisp_Object
-local_vector_init (struct Lisp_Vector *v, ptrdiff_t length, Lisp_Object init)
-{
- v->header.size = length;
- for (ptrdiff_t i = 0; i < length; i++)
- v->contents[i] = init;
- return make_lisp_ptr (v, Lisp_Vectorlike);
-}
-
-#endif
-
-
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
return val;
}
-Lisp_Object
-make_save_int_obj (ptrdiff_t a, Lisp_Object b)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_INT_OBJ;
- p->data[0].integer = a;
- p->data[1].object = b;
- return val;
-}
-
#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
make_save_ptr_ptr (void *a, void *b)
#ifdef WINDOWSNT
return w32_valid_pointer_p (p, 16);
#else
+
+ if (ADDRESS_SANITIZER)
+ return p ? -1 : 0;
+
int fd[2];
/* Obviously, we cannot just access it (we would SEGV trying), so we
return valid;
}
- return -1;
+ return -1;
#endif
}
struct sdata *sdata
= (struct sdata *) (str - offsetof (struct sdata, data));
- if (valid_pointer_p (sdata)
- && valid_pointer_p (sdata->string)
+ if (0 < valid_pointer_p (sdata)
+ && 0 < valid_pointer_p (sdata->string)
&& maybe_lisp_pointer (sdata->string))
return (valid_lisp_object_p
(make_lisp_ptr (sdata->string, Lisp_String))
for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
{
ptr->gcmarkbit = 1;
- mark_object (ptr->start);
- mark_object (ptr->end);
+ /* These two are always markers and can be marked fast. */
+ XMARKER (ptr->start)->gcmarkbit = 1;
+ XMARKER (ptr->end)->gcmarkbit = 1;
mark_object (ptr->plist);
}
}
mark_object (Lisp_Object arg)
{
register Lisp_Object obj = arg;
-#ifdef GC_CHECK_MARKED_OBJECTS
void *po;
+#ifdef GC_CHECK_MARKED_OBJECTS
struct mem_node *m;
#endif
ptrdiff_t cdr_count = 0;
loop:
- if (PURE_POINTER_P (XPNTR (obj)))
+ po = XPNTR (obj);
+ if (PURE_POINTER_P (po))
return;
last_marked[last_marked_index++] = obj;
by ~80%, and requires compilation with GC_MARK_STACK != 0. */
#ifdef GC_CHECK_MARKED_OBJECTS
- po = (void *) XPNTR (obj);
-
/* Check that the object pointed to by PO is known to be a Lisp
structure allocated from the heap. */
#define CHECK_ALLOCATED() \
#else /* not GC_CHECK_MARKED_OBJECTS */
-#define CHECK_LIVE(LIVEP) (void) 0
-#define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
+#define CHECK_LIVE(LIVEP) ((void) 0)
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0)
#endif /* not GC_CHECK_MARKED_OBJECTS */
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
ptr->gcmarkbit = 1;
/* Attempt to catch bogus objects. */
- eassert (valid_lisp_object_p (ptr->function) >= 1);
+ eassert (valid_lisp_object_p (ptr->function));
mark_object (ptr->function);
mark_object (ptr->plist);
switch (ptr->redirect)
++num_used;
sym->s.gcmarkbit = 0;
/* Attempt to catch bogus objects. */
- eassert (valid_lisp_object_p (sym->s.function) >= 1);
+ eassert (valid_lisp_object_p (sym->s.function));
}
}
#endif /* ENABLE_CHECKING */
-#if defined (ENABLE_CHECKING) && defined (USE_STACK_LISP_OBJECTS)
+#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
+
+/* Debugging check whether STR is ASCII-only. */
+
+const char *
+verify_ascii (const char *str)
+{
+ const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str);
+ while (ptr < end)
+ {
+ int c = STRING_CHAR_ADVANCE (ptr);
+ if (!ASCII_CHAR_P (c))
+ emacs_abort ();
+ }
+ return str;
+}
/* Stress alloca with inconveniently sized requests and check
whether all allocated areas may be used for Lisp_Object. */
}
}
-#else /* not (ENABLE_CHECKING && USE_STACK_LISP_OBJECTS) */
+#else /* not ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
#define verify_alloca() ((void) 0)