diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 93 |
1 files changed, 66 insertions, 27 deletions
diff --git a/src/alloc.c b/src/alloc.c index bee7cd1758d..fe55cde49c9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -406,24 +406,37 @@ ALIGN (void *ptr, int alignment) 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) { @@ -3711,6 +3724,23 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) } } +#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) { @@ -5300,10 +5330,6 @@ total_bytes_of_live_objects (void) #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. */ @@ -5318,11 +5344,15 @@ compact_font_cache_entry (Lisp_Object 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 @@ -5331,14 +5361,14 @@ compact_font_cache_entry (Lisp_Object entry) { 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)) @@ -5366,8 +5396,6 @@ compact_font_cache_entry (Lisp_Object entry) return entry; } -#endif /* not HAVE_NTGUI */ - /* Compact font caches on all terminals and mark everything which is still here after compaction. */ @@ -5379,7 +5407,6 @@ compact_font_caches (void) 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; @@ -5387,7 +5414,6 @@ compact_font_caches (void) for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry)) XSETCAR (entry, compact_font_cache_entry (XCAR (entry))); } -#endif /* not HAVE_NTGUI */ mark_object (cache); } } @@ -6301,6 +6327,12 @@ mark_object (Lisp_Object arg) mark_object (XFINALIZER (obj)->function); break; +#ifdef HAVE_MODULES + case Lisp_Misc_User_Ptr: + XMISCANY (obj)->gcmarkbit = true; + break; +#endif + default: emacs_abort (); } @@ -6677,8 +6709,15 @@ sweep_misc (void) { 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. */ |