scratch/comp-static-data 722b58bf9d 2/9: Add static_comp_object_p for working with statically emmited objects

[Vibhav Pant]

branch: scratch/comp-static-data
commit 722b58bf9d83c2de2efbf18737fa97040bcf3094
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>

    Add static_comp_object_p for working with statically emmited objects
    
    * src/alloc.c [HAVE_STATIC_LISP_GLOBALS] (static_comp_object_p): New
    function. When statically emitted lisp objects in native compilation
    are enabled, try to guess whether the provided object can be treated
    as a Lisp object allocated on the heap.
    (mark_object) [HAVE_STATIC_LISP_GLOBALS]: Skip marking the object if
    it has been emitted statically.
    (valid_lisp_object_p, survives_gc_p): Return true if the obj has been
    statically emitted.
    
    * src/puresize.h (puresize_h_CHECK_IMPURE):
    [HAVE_STATIC_LISP_GLOBALS]: Return true for statically emitted objects
    as well, since they are marked as constants during native compilation.
    
    * src/lisp.h (static_comp_object_p): Add declaration.
---
 src/alloc.c    | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 src/lisp.h     |  9 +++++++++
 src/puresize.h |  6 ++++--
 3 files changed, 71 insertions(+), 3 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index b1fa50816e..3a2ff64b19 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2517,6 +2517,11 @@ make_formatted_string (char *buf, const char *format, 
...)
 void
 pin_string (Lisp_Object string)
 {
+#ifdef HAVE_STATIC_LISP_GLOBALS
+  if (static_comp_object_p (string))
+    return;
+#endif
+
   eassert (STRINGP (string) && !STRING_MULTIBYTE (string));
   struct Lisp_String *s = XSTRING (string);
   ptrdiff_t size = STRING_BYTES (s);
@@ -4083,6 +4088,44 @@ set_interval_marked (INTERVAL i)
     i->gcmarkbit = true;
 }
 
+#ifdef HAVE_STATIC_LISP_GLOBALS
+/* Certain self-evaluating Lisp objects in natively compiled code are
+ * emitted as permanently marked. Note that this function does not
+ * *truly* determine if an object was statically compiled, but instead
+ * serves as a (hopefully) fool-proof heuristic to know if it
+ * cannot be treated as an otherwise ordinary heap-allocated object
+ * (whether it is mutable or not, can be freed, etc).  */
+bool
+static_comp_object_p (Lisp_Object obj)
+{
+  if (pdumper_object_p (XPNTR (obj)))
+    return false;
+
+  switch (XTYPE (obj))
+    {
+    case Lisp_String:
+      /* see `emit_lisp_string_constructor_rval' in comp.c */
+      return XSTRING (obj)->u.s.intervals == NULL
+            && string_marked_p (XSTRING (obj))
+            && (STRING_MULTIBYTE (obj)
+                || XSTRING (obj)->u.s.size_byte == -3);
+    case Lisp_Vectorlike:
+      /* see `emit_comp_lisp_obj' in comp.c */
+      return (VECTORP (obj) || RECORDP (obj) || COMPILEDP (obj))
+            && vector_marked_p (XVECTOR (obj));
+    case Lisp_Cons:
+      return cons_marked_p (XCONS (obj));
+    case Lisp_Float:
+      return XFLOAT_MARKED_P (XFLOAT (obj));
+    case Lisp_Symbol:
+    case_Lisp_Int:
+      return false;
+    default:
+      emacs_abort ();
+    }
+}
+#endif
+
 
 /************************************************************************
                           Memory Full Handling
@@ -5299,7 +5342,7 @@ valid_lisp_object_p (Lisp_Object obj)
        return 1;
 
 #ifdef HAVE_STATIC_LISP_GLOBALS
-      return valid;
+      return static_comp_object_p (obj);
 #else
       return 0;
 #endif
@@ -6791,6 +6834,11 @@ process_mark_stack (ptrdiff_t base_sp)
   while (mark_stk.sp > base_sp)
     {
       Lisp_Object obj = mark_stack_pop ();
+#ifdef HAVE_STATIC_LISP_GLOBALS
+      if (static_comp_object_p (obj))
+       continue;
+#endif
+
     mark_obj: ;
       void *po = XPNTR (obj);
       if (PURE_P (po))
@@ -7115,6 +7163,10 @@ process_mark_stack (ptrdiff_t base_sp)
 void
 mark_object (Lisp_Object obj)
 {
+#ifdef HAVE_STATIC_LISP_GLOBALS
+  if (static_comp_object_p (obj))
+    return;
+#endif
   ptrdiff_t sp = mark_stk.sp;
   mark_stack_push_value (obj);
   process_mark_stack (sp);
@@ -7155,6 +7207,11 @@ mark_terminals (void)
 bool
 survives_gc_p (Lisp_Object obj)
 {
+#ifdef HAVE_STATIC_LISP_GLOBALS
+  if (static_comp_object_p (obj))
+    return true;
+#endif
+
   bool survives_p;
 
   switch (XTYPE (obj))
diff --git a/src/lisp.h b/src/lisp.h
index 061d5cf807..3d9c48449a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4237,6 +4237,15 @@ extern void alloc_unexec_post (void);
 extern void mark_c_stack (char const *, char const *);
 extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
 extern void mark_memory (void const *start, void const *end);
+#ifdef HAVE_STATIC_LISP_GLOBALS
+extern bool static_comp_object_p (Lisp_Object obj);
+#else
+INLINE bool
+static_comp_object_p (Lisp_Object obj)
+{
+  return false;
+}
+#endif
 
 /* Force callee-saved registers and register windows onto the stack,
    so that conservative garbage collection can see their values.  */
diff --git a/src/puresize.h b/src/puresize.h
index 4b746924bb..37784784c3 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -96,8 +96,10 @@ PURE_P (void *ptr)
 
 /* Signal an error if OBJ is pure.  PTR is OBJ untagged.  */
 
-#define puresize_h_CHECK_IMPURE(obj, ptr) \
-  (PURE_P (ptr) ? pure_write_error (obj) : (void) 0)
+#define puresize_h_CHECK_IMPURE(obj, ptr)    \
+ (PURE_P (ptr) || static_comp_object_p (obj) \
+    ? pure_write_error (obj)                 \
+    : (void) 0)
 
 INLINE void
 CHECK_IMPURE (Lisp_Object obj, void *ptr)