X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/edb0288b83b45d295df52ce7644e897613358971..9fb9136398821ed5f3a8b4405bbc222964f54028:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index aa5849fee4..eada96c0c1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -69,12 +69,6 @@ along with GNU Emacs. If not, see . */ 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 @@ -540,8 +534,7 @@ buffer_memory_full (ptrdiff_t nbytes) /* 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 \ @@ -2232,34 +2225,7 @@ make_string (const char *contents, ptrdiff_t nbytes) 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) @@ -2328,7 +2294,7 @@ make_specified_string (const char *contents, } -/* 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 @@ -2753,13 +2719,13 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, 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 @@ -3320,23 +3286,6 @@ See also the function `vector'. */) 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. @@ -3657,17 +3606,6 @@ make_save_ptr_int (void *a, ptrdiff_t b) 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) @@ -4995,6 +4933,10 @@ valid_pointer_p (void *p) #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 @@ -5010,7 +4952,7 @@ valid_pointer_p (void *p) return valid; } - return -1; + return -1; #endif } @@ -5109,8 +5051,8 @@ relocatable_string_data_p (const char *str) 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)) @@ -6076,8 +6018,9 @@ mark_overlay (struct Lisp_Overlay *ptr) 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); } } @@ -6212,15 +6155,16 @@ void 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; @@ -6232,8 +6176,6 @@ mark_object (Lisp_Object arg) 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() \ @@ -6260,8 +6202,8 @@ mark_object (Lisp_Object arg) #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 */ @@ -6424,7 +6366,7 @@ mark_object (Lisp_Object arg) 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) @@ -6809,7 +6751,7 @@ sweep_symbols (void) ++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)); } } @@ -7168,7 +7110,22 @@ die (const char *msg, const char *file, int line) #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. */ @@ -7186,7 +7143,7 @@ verify_alloca (void) } } -#else /* not (ENABLE_CHECKING && USE_STACK_LISP_OBJECTS) */ +#else /* not ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ #define verify_alloca() ((void) 0)