/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
If A is a symbol, extract the hidden pointer's offset from lispsym,
converted to void *. */
-static void *
-XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
-{
- intptr_t i = USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK;
- return (void *) i;
-}
+#define macro_XPNTR_OR_SYMBOL_OFFSET(a) \
+ ((void *) (intptr_t) (USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK))
/* Extract the pointer hidden within A. */
-static void *
+#define macro_XPNTR(a) \
+ ((void *) ((intptr_t) XPNTR_OR_SYMBOL_OFFSET (a) \
+ + (SYMBOLP (a) ? (char *) lispsym : NULL)))
+
+/* For pointer access, define XPNTR and XPNTR_OR_SYMBOL_OFFSET as
+ functions, as functions are cleaner and can be used in debuggers.
+ Also, define them as macros if being compiled with GCC without
+ optimization, for performance in that case. The macro_* names are
+ private to this section of code. */
+
+static ATTRIBUTE_UNUSED void *
+XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
+{
+ return macro_XPNTR_OR_SYMBOL_OFFSET (a);
+}
+static ATTRIBUTE_UNUSED void *
XPNTR (Lisp_Object a)
{
- void *p = XPNTR_OR_SYMBOL_OFFSET (a);
- if (SYMBOLP (a))
- p = (intptr_t) p + (char *) lispsym;
- return p;
+ return macro_XPNTR (a);
}
+#if DEFINE_KEY_OPS_AS_MACROS
+# define XPNTR_OR_SYMBOL_OFFSET(a) macro_XPNTR_OR_SYMBOL_OFFSET (a)
+# define XPNTR(a) macro_XPNTR (a)
+#endif
+
static void
XFLOAT_INIT (Lisp_Object f, double n)
{
{
nbytes = XINT (length);
val = make_uninit_string (nbytes);
- memset (SDATA (val), c, nbytes);
- SDATA (val)[nbytes] = 0;
+ if (nbytes)
+ {
+ memset (SDATA (val), c, nbytes);
+ SDATA (val)[nbytes] = 0;
+ }
}
else
{
memcpy (p, beg, len);
}
}
- *p = 0;
+ if (nbytes)
+ *p = 0;
}
return val;
if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
memory_full (SIZE_MAX);
v = allocate_vectorlike (len);
- v->header.size = len;
+ if (len)
+ v->header.size = len;
return v;
}
}
}
+#ifdef HAVE_MODULES
+/* Create a new module user ptr object. */
+Lisp_Object
+make_user_ptr (void (*finalizer) (void *), void *p)
+{
+ Lisp_Object obj;
+ struct Lisp_User_Ptr *uptr;
+
+ obj = allocate_misc (Lisp_Misc_User_Ptr);
+ uptr = XUSER_PTR (obj);
+ uptr->finalizer = finalizer;
+ uptr->p = p;
+ return obj;
+}
+
+#endif
+
static void
init_finalizer_list (struct Lisp_Finalizer *head)
{
return (uintptr_t) p % GCALIGNMENT == 0;
}
+#ifndef HAVE_MODULES
+enum { HAVE_MODULES = false };
+#endif
+
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
#endif
- if (!maybe_lisp_pointer (p))
- return;
+ if (sizeof (Lisp_Object) == sizeof (void *) || !HAVE_MODULES)
+ {
+ if (!maybe_lisp_pointer (p))
+ return;
+ }
+ else
+ {
+ /* For the wide-int case, also mark emacs_value tagged pointers,
+ which can be generated by emacs-module.c's value_to_lisp. */
+ p = (void *) ((uintptr_t) p & ~(GCALIGNMENT - 1));
+ }
m = mem_find (p);
if (m != MEM_NIL)
static void ATTRIBUTE_NO_SANITIZE_ADDRESS
mark_memory (void *start, void *end)
{
- void **pp;
- int i;
+ char *pp;
/* Make START the pointer to the start of the memory region,
if it isn't already. */
end = tem;
}
+ eassert (((uintptr_t) start) % GC_POINTER_ALIGNMENT == 0);
+
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
only a pointer to them remains. Example:
away. The only reference to the life string is through the
pointer `s'. */
- for (pp = start; (void *) pp < end; pp++)
- for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
- {
- void *p = *(void **) ((char *) pp + i);
- mark_maybe_pointer (p);
- mark_maybe_object (XIL ((intptr_t) p));
- }
+ for (pp = start; (void *) pp < end; pp += GC_POINTER_ALIGNMENT)
+ {
+ mark_maybe_pointer (*(void **) pp);
+ mark_maybe_object (*(Lisp_Object *) pp);
+ }
}
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
#ifdef HAVE_WINDOW_SYSTEM
-/* This code has a few issues on MS-Windows, see Bug#15876 and Bug#16140. */
-
-#if !defined (HAVE_NTGUI)
-
/* Remove unmarked font-spec and font-entity objects from ENTRY, which is
(DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry. */
Lisp_Object obj = XCAR (tail);
/* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */
- if (CONSP (obj) && FONT_SPEC_P (XCAR (obj))
- && !VECTOR_MARKED_P (XFONT_SPEC (XCAR (obj)))
- && VECTORP (XCDR (obj)))
+ if (CONSP (obj) && GC_FONT_SPEC_P (XCAR (obj))
+ && !VECTOR_MARKED_P (GC_XFONT_SPEC (XCAR (obj)))
+ /* Don't use VECTORP here, as that calls ASIZE, which could
+ hit assertion violation during GC. */
+ && (VECTORLIKEP (XCDR (obj))
+ && ! (gc_asize (XCDR (obj)) & PSEUDOVECTOR_FLAG)))
{
- ptrdiff_t i, size = ASIZE (XCDR (obj)) & ~ARRAY_MARK_FLAG;
+ ptrdiff_t i, size = gc_asize (XCDR (obj));
+ Lisp_Object obj_cdr = XCDR (obj);
/* If font-spec is not marked, most likely all font-entities
are not marked too. But we must be sure that nothing is
{
Lisp_Object objlist;
- if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i))))
+ if (VECTOR_MARKED_P (GC_XFONT_ENTITY (AREF (obj_cdr, i))))
break;
- objlist = AREF (AREF (XCDR (obj), i), FONT_OBJLIST_INDEX);
+ objlist = AREF (AREF (obj_cdr, i), FONT_OBJLIST_INDEX);
for (; CONSP (objlist); objlist = XCDR (objlist))
{
Lisp_Object val = XCAR (objlist);
- struct font *font = XFONT_OBJECT (val);
+ struct font *font = GC_XFONT_OBJECT (val);
if (!NILP (AREF (val, FONT_TYPE_INDEX))
&& VECTOR_MARKED_P(font))
return entry;
}
-#endif /* not HAVE_NTGUI */
-
/* Compact font caches on all terminals and mark
everything which is still here after compaction. */
for (t = terminal_list; t; t = t->next_terminal)
{
Lisp_Object cache = TERMINAL_FONT_CACHE (t);
-#if !defined (HAVE_NTGUI)
if (CONSP (cache))
{
Lisp_Object entry;
for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry))
XSETCAR (entry, compact_font_cache_entry (XCAR (entry)));
}
-#endif /* not HAVE_NTGUI */
mark_object (cache);
}
}
don't let that cause a recursive GC. */
consing_since_gc = 0;
- /* Save what's currently displayed in the echo area. */
- message_p = push_message ();
- record_unwind_protect_void (pop_message_unwind);
+ /* Save what's currently displayed in the echo area. Don't do that
+ if we are GC'ing because we've run out of memory, since
+ push_message will cons, and we might have no memory for that. */
+ if (NILP (Vmemory_full))
+ {
+ message_p = push_message ();
+ record_unwind_protect_void (pop_message_unwind);
+ }
+ else
+ message_p = false;
/* Save a copy of the contents of the stack, for debugging. */
#if MAX_SAVE_STACK > 0
}
}
- if (garbage_collection_messages)
+ if (garbage_collection_messages && NILP (Vmemory_full))
{
if (message_p || minibuf_level > 0)
restore_message ();
mark_object (XFINALIZER (obj)->function);
break;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ XMISCANY (obj)->gcmarkbit = true;
+ break;
+#endif
+
default:
emacs_abort ();
}
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
unchain_marker (&mblk->markers[i].m.u_marker);
- if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+ else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
unchain_finalizer (&mblk->markers[i].m.u_finalizer);
+#ifdef HAVE_MODULES
+ else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
+ {
+ struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
+ uptr->finalizer (uptr->p);
+ }
+#endif
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */