src/comp.c: Simplify alloc_class_check.

When compiling with USE_COMP_STATIC_LISP_OBJECTS, don't create new
globals for objects that need to be initialized in
comp_init_objs. Instead, use array references to the ephemeral and
staticvec vectors.

* src/comp.c (emit_static_lisp_obj_var): Take alloc_class as a
parameter, use it to determine which array to reference.
(define_init_objs): Set the ephemeral and staticvec pointers to the
newly created container vectors, remove init_vars_block.
(Fcomp__compile_ctxt_to_file): Initialize the ephemeral and staticvec
pointers for the compilation context.

lisp/Makefile.in

@@ -71,12 +71,17 @@ loaddefs = $(shell find ${srcdir} -name '*loaddefs.el' ! -name '.*')
 AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
   ${srcdir}/subdirs.el ${srcdir}/eshell/esh-groups.el
 
+# Additional flags to pass while compiling *.eln files
+ELN_COMPILE_FLAGS =
+
 # Set load-prefer-newer for the benefit of the non-bootstrappers.
 BYTE_COMPILE_FLAGS = \
   --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \
 	$(BYTE_COMPILE_EXTRA_FLAGS)
 # ... but we must prefer .elc files for those in the early bootstrap.
 compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS)
+compile-first: ELN_COMPILE_FLAGS = \
+  --eval "(setq native-comp-compile-static-data nil)"
 
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.  They're ordered by size, so we use
@@ -279,7 +284,7 @@ THEFILE = no-such-file
 .PHONY: $(THEFILE)c
 $(THEFILE)c:
 ifeq ($(HAVE_NATIVE_COMP),yes)
-	$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
+	$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) $(ELN_COMPILE_FLAGS) \
 		-l comp -f byte-compile-refresh-preloaded \
 		-f batch-byte+native-compile $(THEFILE)
 else
@@ -291,7 +296,7 @@ endif
 ifeq ($(HAVE_NATIVE_COMP),yes)
 .PHONY: $(THEFILE)n
 $(THEFILE)n:
-	$(AM_V_ELN)$(emacs) $(BYTE_COMPILE_FLAGS) \
+	$(AM_V_ELN)$(emacs) $(BYTE_COMPILE_FLAGS) $(ELN_COMPILE_FLAGS) \
 		-l comp -f byte-compile-refresh-preloaded \
 		--eval '(batch-native-compile t)' $(THEFILE)
 endif
@@ -324,7 +329,7 @@ ifeq ($(ANCIENT),yes)
 	TZ=UTC0 touch -t 197001010000 $@
 else
 .el.elc:
-	$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
+	$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) $(ELN_COMPILE_FLAGS) \
 	-l comp -f batch-byte+native-compile $<
 endif
 else

lisp/emacs-lisp/comp.el

@@ -80,6 +80,13 @@ This is intended for debugging the compiler itself.
   :risky t
   :version "28.1")
 
+(defcustom native-comp-compile-static-data t
+  "If non nil, compile constants referenced by Lisp code as static data
+into the eln output.  "
+  :type 'boolean
+  :safe #'booleanp
+  :version "29.1")
+
 (defcustom native-comp-always-compile nil
   "Non-nil means unconditionally (re-)compile all files."
   :type 'boolean
@@ -823,7 +830,10 @@ This is typically for top-level forms other than defun.")
   (d-ephemeral (make-comp-data-container) :type comp-data-container
                :documentation "Relocated data not necessary after load.")
   (with-late-load nil :type boolean
-                  :documentation "When non-nil support late load."))
+                  :documentation "When non-nil support late load.")
+  (with-static-data native-comp-compile-static-data :type boolean
+		    :documentation
+		    "When non-nil compile lisp constants statically."))
 
 (cl-defstruct comp-args-base
   (min nil :type integer
@@ -1302,7 +1312,8 @@ clashes."
                 (comp-byte-frame-size (comp-func-byte-func func))))
         (setf (comp-ctxt-top-level-forms comp-ctxt)
               (list (make-byte-to-native-func-def :name function-name
-                                                  :c-name c-name)))
+                                                  :c-name c-name))
+              (comp-ctxt-with-static-data comp-ctxt) nil)
         (comp-add-func-to-ctxt func))))
 
 (cl-defmethod comp-spill-lap-function ((form list))
@@ -2143,32 +2154,40 @@ These are stored in the reloc data array."
   (let ((args (comp-prepare-args-for-top-level func)))
     (let ((comp-curr-allocation-class 'd-impure))
       (comp-add-const-to-relocs (comp-func-byte-func func)))
-    (comp-emit
-     (comp-call 'comp--register-lambda
-                ;; mvar to be fixed-up when containers are
-                ;; finalized.
-                (or (gethash (comp-func-byte-func func)
-                             (comp-ctxt-lambda-fixups-h comp-ctxt))
-                    (puthash (comp-func-byte-func func)
-                             (make-comp-mvar :constant nil)
-                             (comp-ctxt-lambda-fixups-h comp-ctxt)))
-                (make-comp-mvar :constant (comp-func-c-name func))
-                (car args)
-                (cdr args)
-                (setf (comp-func-type func)
-                      (make-comp-mvar :constant nil))
-                (make-comp-mvar
-                 :constant
-                 (list
-                  (let* ((h (comp-ctxt-function-docs comp-ctxt))
-                         (i (hash-table-count h)))
-                    (puthash i (comp-func-doc func) h)
-                    i)
-                  (comp-func-int-spec func)
-                  (comp-func-command-modes func)))
-                ;; This is the compilation unit it-self passed as
-                ;; parameter.
-                (make-comp-mvar :slot 0)))))
+    (let ((func-type-mvar (setf (comp-func-type func)
+				(make-comp-mvar :constant nil)))
+          (doc-idx (let* ((h (comp-ctxt-function-docs comp-ctxt))
+			  (i (hash-table-count h)))
+                     (puthash i (comp-func-doc func) h)
+                     i)))
+      (unless (and (featurep 'comp--static-lisp-consts)
+                   native-comp-compile-static-data
+                   (comp-ctxt-with-static-data comp-ctxt))
+        ;; When constants are statically compiled in, we just need
+        ;; the function type mvar and docstring index to be set, as
+        ;; anonymous lambdas are statically created as well.
+        (comp-emit
+         (comp-call 'comp--register-lambda
+                    ;; mvar to be fixed-up when containers are
+                    ;; finalized.
+                    (or (gethash (comp-func-byte-func func)
+				 (comp-ctxt-lambda-fixups-h comp-ctxt))
+			(puthash (comp-func-byte-func func)
+				 (make-comp-mvar :constant nil)
+				 (comp-ctxt-lambda-fixups-h comp-ctxt)))
+                    (make-comp-mvar :constant (comp-func-c-name func))
+                    (car args)
+                    (cdr args)
+                    func-type-mvar
+                    (make-comp-mvar
+                     :constant
+                     (list
+                      doc-idx
+                      (comp-func-int-spec func)
+                      (comp-func-command-modes func)))
+                    ;; This is the compilation unit it-self passed as
+                    ;; parameter.
+                    (make-comp-mvar :slot 0)))))))
 
 (defun comp-limplify-top-level (for-late-load)
   "Create a Limple function to modify the global environment at load.
@@ -2208,8 +2227,8 @@ into the C code forwarding the compilation unit."
     ;; Assign the compilation unit incoming as parameter to the slot frame 0.
     (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0))
     (maphash (lambda (_ func)
-               (comp-emit-lambda-for-top-level func))
-             (comp-ctxt-byte-func-to-func-h comp-ctxt))
+                 (comp-emit-lambda-for-top-level func))
+               (comp-ctxt-byte-func-to-func-h comp-ctxt))
     (mapc (lambda (x) (comp-emit-for-top-level x for-late-load))
           (comp-ctxt-top-level-forms comp-ctxt))
     (comp-emit `(return ,(make-comp-mvar :slot 1)))
@@ -3713,6 +3732,7 @@ Prepare every function for final compilation and drive the C back-end."
              (expr `((require 'comp)
                      (setf native-comp-verbose ,native-comp-verbose
                            comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+                           native-comp-compile-static-data ,native-comp-compile-static-data
                            comp-ctxt ,comp-ctxt
                            native-comp-eln-load-path ',native-comp-eln-load-path
                            native-comp-compiler-options
@@ -3846,6 +3866,9 @@ Return the trampoline if found or nil otherwise."
          ;; funcall calls!
          (byte-optimize nil)
          (native-comp-speed 1)
+         ;; Disable emitting static data if the trampoline eln might be
+         ;; dumped.
+         (native-comp-compile-static-data nil)
          (lexical-binding t))
     (comp--native-compile
      form nil
@@ -3980,6 +4003,7 @@ display a message."
                                  warning-fill-column most-positive-fixnum)
                            ,(let ((set (list 'setq)))
                               (dolist (var '(comp-file-preloaded-p
+                                             native-comp-compile-static-data
                                              native-compile-target-directory
                                              native-comp-speed
                                              native-comp-debug

src/.gdbinit

@@ -829,6 +829,20 @@ Print $ as a compiled function pointer.
 This command assumes that $ is an Emacs Lisp compiled value.
 end
 
+define xnativecompunit
+  xgetptr $
+  print (struct Lisp_Native_Comp_Unit *) $ptr
+  set $nativecompunit = (struct Lisp_Native_Comp_Unit *) $ptr
+  xgettype $nativecompunit->file
+  xgetptr $nativecompunit->file
+  output ($type == Lisp_String ? ((char *) (struct Lisp_String *) $ptr)->u.s.data : (struct Lisp_Cons *)$ptr)
+  echo \n
+end
+document xnativecompunit
+Print $ as a native compiled unit.
+This command assumes that $ is an Emacs Lisp native compiled unit value.
+end
+
 define xwindow
   xgetptr $
   print (struct window *) $ptr
@@ -1037,6 +1051,9 @@ define xpr
       if $vec == PVEC_COMPILED
 	xcompiled
       end
+      if $vec == PVEC_NATIVE_COMP_UNIT
+        xnativecompunit
+      end
       if $vec == PVEC_WINDOW
 	xwindow
       end

src/Makefile.in

@@ -840,6 +840,7 @@ tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS $(lib)/TAGS
 
 %.elc: %.el | bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp)
 	@$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="$(bootstrap_exe)"\
+		ELN_COMPILE_FLAGS='--eval "(setq native-comp-compile-static-data nil)"' \
 		THEFILE=$< $<c
 
 ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:)
@@ -862,6 +863,7 @@ elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln)
 
 %.eln: %.el | emacs$(EXEEXT) $(pdmp)
 	@$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="../src/emacs$(EXEEXT)"\
+		ELN_COMPILE_FLAGS='--eval "(setq native-comp-compile-static-data nil)"' \
 		THEFILE=$< $<n
 
 ## FIXME: this is fragile!  We lie to Make about the files produced by

src/alloc.c

@@ -24,6 +24,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <stdlib.h>
 #include <limits.h>		/* For CHAR_BIT.  */
 #include <signal.h>		/* For SIGABRT, SIGDANGER.  */
+#include "lisp.h"
 
 #ifdef HAVE_PTHREAD
 #include <pthread.h>
@@ -119,6 +120,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 # define GC_CHECK_MARKED_OBJECTS 1
 #endif
 
+
 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
    memory.  Can do this only if using gmalloc.c and if not checking
    marked objects.  */
@@ -1090,6 +1092,10 @@ lisp_free (void *block)
 #endif
 verify (POWER_OF_2 (BLOCK_ALIGN));
 
+#ifdef HAVE_NATIVE_COMP
+const size_t block_align = BLOCK_ALIGN;
+#endif
+
 /* Use aligned_alloc if it or a simple substitute is available.
    Aligned allocation is incompatible with unexmacosx.c, so don't use
    it on Darwin if HAVE_UNEXEC.  */
@@ -2657,7 +2663,8 @@ pin_string (Lisp_Object string)
       SDATA_NBYTES (old_sdata) = size;
       ASAN_PREPARE_DEAD_SDATA (old_sdata, size);
     }
-  s->u.s.size_byte = -3;
+  if (s->u.s.size_byte != -3)
+    s->u.s.size_byte = -3;
 }
 
 
@@ -2676,6 +2683,12 @@ pin_string (Lisp_Object string)
      - (sizeof (struct Lisp_Float) - sizeof (bits_word))) * CHAR_BIT) \
    / (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
 
+#ifdef HAVE_NATIVE_COMP
+const size_t float_block_floats_length = FLOAT_BLOCK_SIZE;
+const size_t float_block_gcmarkbits_length
+  = 1 + FLOAT_BLOCK_SIZE / BITS_PER_BITS_WORD;
+#endif
+
 #define GETMARKBIT(block,n)				\
   (((block)->gcmarkbits[(n) / BITS_PER_BITS_WORD]	\
     >> ((n) % BITS_PER_BITS_WORD))			\
@@ -2801,6 +2814,12 @@ make_float (double float_value)
      - (sizeof (struct Lisp_Cons) - sizeof (bits_word))) * CHAR_BIT)	\
    / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
 
+#ifdef HAVE_NATIVE_COMP
+const size_t cons_block_conses_length = CONS_BLOCK_SIZE;
+const size_t cons_block_gcmarkbits_length
+  = 1 + CONS_BLOCK_SIZE / BITS_PER_BITS_WORD;
+#endif
+
 #define CONS_BLOCK(fptr) \
   (eassert (!pdumper_object_p (fptr)),                                  \
    ((struct cons_block *) ((uintptr_t) (fptr) & ~(BLOCK_ALIGN - 1))))
@@ -3776,6 +3795,11 @@ usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */)
   ptrdiff_t protosize = PVSIZE (protofun);
   struct Lisp_Vector *v = allocate_vectorlike (protosize, false);
   v->header = XVECTOR (protofun)->header;
+#if USE_COMP_STATIC_LISP_OBJECTS
+  /* We might be copying from a vector statically allocated during
+     native compilation, be sure to unset the mark flag.  */
+  v->header.size &= ~ARRAY_MARK_FLAG;
+#endif
   memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size);
   v->contents[COMPILED_CONSTANTS] = constvec;
   return make_lisp_ptr (v, Lisp_Vectorlike);
@@ -4276,6 +4300,68 @@ set_interval_marked (INTERVAL i)
     i->gcmarkbit = true;
 }
 
+#if USE_COMP_STATIC_LISP_OBJECTS
+/* Certain self-evaluating Lisp objects in natively compiled code are
+   emitted as permanently marked. When called **outside of GC**,
+   static_comp_object_p returns whether the passed argument is one
+   such object.  Note that this function does not *truly* determine if
+   an object was statically compiled (i.e, it lies inside the address
+   space of a dlopen'ed eln object), but instead checks for certain
+   properties that these objects are compiled with.  The purpose of
+   this function is to decide if an object 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)
+{
+  void *ptr = XPNTR (obj);
+  if (pdumper_object_p (ptr))
+    return false;
+
+  /* If the object points to Lisp data allocated outside the heap,
+     it likely exists in a native compiled eln file. Either way, we
+     should not be mutating it, so it's good enough for this function.  */
+  if (ptr < min_heap_address || ptr > max_heap_address)
+    return true;
+
+  switch (XTYPE (obj))
+    {
+    case Lisp_String:
+      /* See `emit_lisp_string_constructor_rval' in comp.c. Statically
+       compiled strings also have no intervals, and have u.s.size_byte
+       == -3 if they're unibyte.  */
+      return string_marked_p (XSTRING (obj));
+    case Lisp_Vectorlike:
+      /* see `emit_comp_lisp_obj' in comp.c */
+      return vector_marked_p (XVECTOR (obj));
+    case Lisp_Cons:
+      {
+	/* The cons_block for static comp cons objects have all bits for
+	   its conses marked.  */
+	struct cons_block *blk = CONS_BLOCK (XCONS (obj));
+	for (ptrdiff_t i = 0; i < cons_block_gcmarkbits_length; i++)
+	  if (blk->gcmarkbits[i] != BITS_WORD_MAX)
+	    return false;
+	return true;
+      }
+    case Lisp_Float:
+      {
+	/* Ditto, for floats as well.  */
+	struct float_block *blk = FLOAT_BLOCK (XFLOAT (obj));
+	for (ptrdiff_t i = 0; i < float_block_gcmarkbits_length; i++)
+	  if (blk->gcmarkbits[i] != BITS_WORD_MAX)
+	    return false;
+	return true;
+      }
+    case Lisp_Symbol:
+    case_Lisp_Int:
+      return false;
+    default:
+      emacs_abort ();
+    }
+}
+#endif
+
 
 /************************************************************************
 			   Memory Full Handling
@@ -5527,7 +5613,11 @@ valid_lisp_object_p (Lisp_Object obj)
       if (SUBRP (obj) || STRINGP (obj) || CONSP (obj))
 	return 1;
 
+#if USE_COMP_STATIC_LISP_OBJECTS
+      return static_comp_object_p (obj);
+#else
       return 0;
+#endif
     }
 
   switch (m->type)
@@ -6157,6 +6247,15 @@ compact_undo_list (Lisp_Object list)
   return list;
 }
 
+void
+pin_object (Lisp_Object obj)
+{
+  struct pinned_object *o = xmalloc (sizeof *o);
+  o->object = obj;
+  o->next = pinned_objects;
+  pinned_objects = o;
+}
+
 static void
 mark_pinned_objects (void)
 {
@@ -6192,6 +6291,9 @@ visit_vectorlike_root (struct gc_root_visitor visitor,
 
   if (size & PSEUDOVECTOR_FLAG)
     size &= PSEUDOVECTOR_SIZE_MASK;
+#if USE_COMP_STATIC_LISP_OBJECTS
+  size &= ~ARRAY_MARK_FLAG;
+#endif
   for (i = 0; i < size; i++)
     visitor.visit (&ptr->contents[i], type, visitor.data);
 }
@@ -6758,6 +6860,39 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
     }
 }
 
+static void mark_stack_push_values (Lisp_Object *values, ptrdiff_t n);
+
+static void
+mark_native_comp_unit (struct Lisp_Vector *ptr)
+{
+  struct Lisp_Native_Comp_Unit *comp_u
+    = (struct Lisp_Native_Comp_Unit *) ptr;
+  ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+  set_vector_marked (ptr);
+  mark_stack_push_values (ptr->contents, size);
+
+#if USE_COMP_STATIC_LISP_OBJECTS
+  if (comp_u->have_static_lisp_data)
+    {
+      eassert (NILP (comp_u->lambda_gc_guard_h));
+      eassert (NILP (comp_u->lambda_c_name_idx_h));
+      eassert (NILP (comp_u->data_vec));
+      eassert (NILP (comp_u->data_impure_vec));
+      eassert (comp_u->data_imp_relocs == NULL);
+
+      Lisp_Object u_staticvec = comp_u->staticpro;
+      if (!NILP (u_staticvec))
+	mark_stack_push_values (XVECTOR (u_staticvec)->contents,
+				ASIZE (u_staticvec));
+
+      Lisp_Object u_ephemeral = comp_u->ephemeral;
+      if (!NILP (u_ephemeral))
+	mark_stack_push_values (XVECTOR (u_ephemeral)->contents,
+				ASIZE (u_ephemeral));
+    }
+#endif
+}
+
 /* Mark the chain of overlays starting at PTR.  */
 
 static void
@@ -7017,6 +7152,7 @@ process_mark_stack (ptrdiff_t base_sp)
   while (mark_stk.sp > base_sp)
     {
       Lisp_Object obj = mark_stack_pop ();
+
     mark_obj: ;
       void *po = XPNTR (obj);
       if (PURE_P (po))
@@ -7109,7 +7245,7 @@ process_mark_stack (ptrdiff_t base_sp)
 	    enum pvec_type pvectype
 	      = PSEUDOVECTOR_TYPE (ptr);
 
-#ifdef GC_CHECK_MARKED_OBJECTS
+#if GC_CHECK_MARKED_OBJECTS
 	    if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po))
 	      {
 		m = mem_find (po);
@@ -7193,6 +7329,10 @@ process_mark_stack (ptrdiff_t base_sp)
 #endif
 		break;
 
+	      case PVEC_NATIVE_COMP_UNIT:
+		mark_native_comp_unit (ptr);
+		break;
+
 	      case PVEC_FREE:
 		emacs_abort ();
 
@@ -7246,7 +7386,8 @@ process_mark_stack (ptrdiff_t base_sp)
 		break;
 	      default: emacs_abort ();
 	      }
-	    if (!PURE_P (XSTRING (ptr->u.s.name)))
+	    if (!PURE_P (XSTRING (ptr->u.s.name))
+		&& !string_marked_p (XSTRING (ptr->u.s.name)))
 	      set_string_marked (XSTRING (ptr->u.s.name));
 	    mark_interval_tree (string_intervals (ptr->u.s.name));
 	    /* Inner loop to mark next symbol in this bucket, if any.  */

src/casefiddle.c

@@ -140,7 +140,7 @@ case_character_impl (struct casing_str_buf *buf,
           struct Lisp_String *str = XSTRING (prop);
           if (STRING_BYTES (str) <= sizeof buf->data)
 	    {
-	      buf->len_chars = str->u.s.size;
+	      buf->len_chars = STRING_CHARS (str);
 	      buf->len_bytes = STRING_BYTES (str);
 	      memcpy (buf->data, str->u.s.data, buf->len_bytes);
 	      return 1;

src/ccl.c

@@ -2001,7 +2001,7 @@ setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
       if (! VECTORP (ccl_prog))
 	return false;
       vp = XVECTOR (ccl_prog);
-      ccl->size = vp->header.size;
+      ccl->size = VECTOR_ASIZE (vp);
       ccl->prog = vp->contents;
       ccl->eof_ic = XFIXNUM (vp->contents[CCL_HEADER_EOF]);
       ccl->buf_magnification = XFIXNUM (vp->contents[CCL_HEADER_BUF_MAG]);

src/comp.h

@@ -22,6 +22,40 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <dynlib.h>
 
+#ifdef HAVE_NATIVE_COMP
+# include <libgccjit.h>
+/* If USE_COMP_STATIC_LISP_OBJECTS, allow the AOT native compiler to
+   compile self evaluating Lisp forms as static consts in the
+   generated eln.  Just like USE_STACK_LISP_OBJECTS, these objects
+   have better performance, and can significantly reduce heap usage.
+   Such objects are perma-marked, which means that data structures
+   that store the mark bit as a bitfield need to unset it in functions
+   that make use of the field in which it's stored (ASIZE for
+   Lisp_Vectors, SCHARS for Lisp_Strings, etc).  A good way to think
+   about them is as every eln file having its own purespace for
+   storing self-evaluating forms.
+
+   Just like objects in purespace, these objects are emitted as
+   consts, so modifying them is illegal. To enforce that, we add an
+   additional check to CHECK_IMPURE that checks if the object being
+   modified is emitted statically by comp, exploiting their
+   "perma-marked" nature (see static_comp_object_p in alloc.c).
+
+   To make debugging a little easier, this is only enabled alongside
+   USE_STACK_LISP_OBJECTS, and when GC runtime checks are disabled. */
+# if defined(LIBGCCJIT_HAVE_REFLECTION)                           \
+   && defined(LIBGCCJIT_HAVE_CTORS)                               \
+   && defined(LIBGCCJIT_HAVE_gcc_jit_type_get_aligned)            \
+   && defined(LIBGCCJIT_HAVE_ALIGNMENT) && USE_STACK_LISP_OBJECTS \
+   && !GC_CHECK_MARKED_OBJECTS
+#  define USE_COMP_STATIC_LISP_OBJECTS 1
+# else
+#  define USE_COMP_STATIC_LISP_OBJECTS 0
+# endif
+#else
+# define USE_COMP_STATIC_LISP_OBJECTS 0
+#endif
+
 struct Lisp_Native_Comp_Unit
 {
   union vectorlike_header header;
@@ -49,6 +83,16 @@ struct Lisp_Native_Comp_Unit
   bool loaded_once;
   bool load_ongoing;
   dynlib_handle_ptr handle;
+  bool have_static_lisp_data;
+
+#if USE_COMP_STATIC_LISP_OBJECTS
+  /* vector of dynamically allocated lisp objects, marked manually on GC.  */
+  Lisp_Object staticpro;
+  /* vector of ephemeral objects that need to be marked only during
+     top_level_run.  */
+  Lisp_Object ephemeral;
+#endif
+
 } GCALIGNED_STRUCT;
 
 #ifdef HAVE_NATIVE_COMP

src/indent.c

@@ -111,7 +111,7 @@ disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *w
 {
   int i;
 
-  eassert (widthtab->header.size == 256);
+  eassert (VECTOR_ASIZE (widthtab) == 256);
 
   for (i = 0; i < 256; i++)
     if (character_width (i, disptab)
@@ -132,7 +132,7 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
   if (!VECTORP (BVAR (buf, width_table)))
     bset_width_table (buf, make_uninit_vector (256));
   widthtab = XVECTOR (BVAR (buf, width_table));
-  eassert (widthtab->header.size == 256);
+  eassert (VECTOR_ASIZE (widthtab) == 256);
 
   for (i = 0; i < 256; i++)
     XSETFASTINT (widthtab->contents[i], character_width (i, disptab));

src/lisp.h

@@ -124,10 +124,12 @@ enum {  BOOL_VECTOR_BITS_PER_CHAR =
    its bits are used.  */
 #if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
 typedef size_t bits_word;
+#define BITS_WORD_IS_SIGNED true
 # define BITS_WORD_MAX SIZE_MAX
 enum { BITS_PER_BITS_WORD = SIZE_WIDTH };
 #else
 typedef unsigned char bits_word;
+# define BITS_WORD_IS_SIGNED false
 # define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
 enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
 #endif
@@ -1442,6 +1444,27 @@ make_pointer_integer (void *p)
 
 typedef struct interval *INTERVAL;
 
+/* If USE_STACK_LISP_OBJECTS, define macros and functions that
+   allocate some Lisp objects on the C stack.  As the storage is not
+   managed by the garbage collector, these objects are dangerous:
+   passing them to user code could result in undefined behavior if the
+   objects are in use after the C function returns.  Conversely, these
+   objects have better performance because GC is not involved.
+
+   While debugging you may want to disable allocation on the C stack.
+   Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it.  */
+
+#if (!defined USE_STACK_LISP_OBJECTS \
+     && defined __GNUC__ && !defined __clang__ && ! GNUC_PREREQ (4, 3, 2))
+  /* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2.  */
+# define USE_STACK_LISP_OBJECTS false
+#endif
+#ifndef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS true
+#endif
+
+#include "comp.h"
+
 struct Lisp_Cons
 {
   union
@@ -1690,6 +1713,9 @@ INLINE ptrdiff_t
 SCHARS (Lisp_Object string)
 {
   ptrdiff_t nchars = XSTRING (string)->u.s.size;
+#if USE_COMP_STATIC_LISP_OBJECTS
+  nchars &= ~ARRAY_MARK_FLAG;
+#endif
   eassume (0 <= nchars);
   return nchars;
 }
@@ -1702,6 +1728,10 @@ STRING_BYTES (struct Lisp_String *s)
 {
 #ifdef GC_CHECK_STRING_BYTES
   ptrdiff_t nbytes = string_bytes (s);
+#elif USE_COMP_STATIC_LISP_OBJECTS
+  ptrdiff_t nbytes
+    = (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG
+                            : s->u.s.size_byte);
 #else
   ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte;
 #endif
@@ -1709,6 +1739,17 @@ STRING_BYTES (struct Lisp_String *s)
   return nbytes;
 }
 
+INLINE ptrdiff_t
+STRING_CHARS (struct Lisp_String *s)
+{
+  ptrdiff_t nchars = s->u.s.size;
+#if USE_COMP_STATIC_LISP_OBJECTS
+  nchars &= ~ARRAY_MARK_FLAG;
+#endif
+  eassume (0 <= nchars);
+  return nchars;
+}
+
 INLINE ptrdiff_t
 SBYTES (Lisp_Object string)
 {
@@ -1760,19 +1801,33 @@ XVECTOR (Lisp_Object a)
   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Vector);
 }
 
+INLINE ptrdiff_t
+gc_asize (Lisp_Object array)
+{
+  /* Like ASIZE, but also can be used in the garbage collector.  */
+  return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
+}
+
 INLINE ptrdiff_t
 ASIZE (Lisp_Object array)
 {
+#if USE_COMP_STATIC_LISP_OBJECTS
+  ptrdiff_t size = gc_asize (array);
+#else
   ptrdiff_t size = XVECTOR (array)->header.size;
+#endif
   eassume (0 <= size);
   return size;
 }
 
 INLINE ptrdiff_t
-gc_asize (Lisp_Object array)
+VECTOR_ASIZE (struct Lisp_Vector *v)
 {
-  /* Like ASIZE, but also can be used in the garbage collector.  */
-  return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
+#if USE_COMP_STATIC_LISP_OBJECTS
+  return v->header.size & ~ARRAY_MARK_FLAG;
+#else
+  return v->header.size;
+#endif
 }
 
 INLINE ptrdiff_t
@@ -2146,8 +2201,6 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
     char_table_set (ct, idx, val);
 }
 
-#include "comp.h"
-
 /* This structure describes a built-in function.
    It is generated by the DEFUN macro only.
    defsubr makes it into a Lisp object.  */
@@ -4206,6 +4259,27 @@ 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);
+extern void pin_object (Lisp_Object obj);
+#if USE_COMP_STATIC_LISP_OBJECTS
+extern bool static_comp_object_p (Lisp_Object obj);
+#else
+INLINE bool
+static_comp_object_p (Lisp_Object obj)
+{
+  return false;
+}
+#endif
+
+#ifdef HAVE_NATIVE_COMP
+extern const size_t block_align;
+
+extern const size_t float_block_floats_length;
+extern const size_t float_block_gcmarkbits_length;
+
+extern const size_t cons_block_conses_length;
+extern const size_t cons_block_gcmarkbits_length;
+#endif /* #ifndef HAVE_NATIVE_COMP */
+
 
 /* Force callee-saved registers and register windows onto the stack,
    so that conservative garbage collection can see their values.  */
@@ -5453,26 +5527,6 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val)
 
 #define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0)
 
-
-/* If USE_STACK_LISP_OBJECTS, define macros and functions that
-   allocate some Lisp objects on the C stack.  As the storage is not
-   managed by the garbage collector, these objects are dangerous:
-   passing them to user code could result in undefined behavior if the
-   objects are in use after the C function returns.  Conversely, these
-   objects have better performance because GC is not involved.
-
-   While debugging you may want to disable allocation on the C stack.
-   Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it.  */
-
-#if (!defined USE_STACK_LISP_OBJECTS \
-     && defined __GNUC__ && !defined __clang__ && ! GNUC_PREREQ (4, 3, 2))
-  /* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2.  */
-# define USE_STACK_LISP_OBJECTS false
-#endif
-#ifndef USE_STACK_LISP_OBJECTS
-# define USE_STACK_LISP_OBJECTS true
-#endif
-
 #ifdef GC_CHECK_STRING_BYTES
 enum { defined_GC_CHECK_STRING_BYTES = true };
 #else

src/pdumper.c

@@ -2959,6 +2959,9 @@ dump_native_comp_unit (struct dump_context *ctx,
   if (!CONSP (comp_u->file))
     error ("Trying to dump non fixed-up eln file");
 
+  if (comp_u->have_static_lisp_data)
+    error ("Trying to dump eln file with static lisp data");
+
   /* Have function documentation always lazy loaded to optimize load-time.  */
   comp_u->data_fdoc_v = Qnil;
   START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out);
@@ -3120,6 +3123,7 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
 # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h."
 #endif
   eassert (!EQ (object, dead_object ()));
+  eassert (!static_comp_object_p (object));
 
   dump_off offset = dump_recall_object (ctx, object);
   if (offset > 0)
@@ -5351,7 +5355,12 @@ dump_do_dump_relocation (const uintptr_t dump_base,
 	struct Lisp_Native_Comp_Unit *comp_u =
 	  dump_ptr (dump_base, reloc_offset);
 	comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq);
-	if (STRINGP (comp_u->file))
+
+        if (comp_u->have_static_lisp_data)
+          error ("Compilation unit for eln file with static lisp "
+                 "data was dumped");
+
+        if (STRINGP (comp_u->file))
 	  error ("Trying to load incoherent dumped eln file %s",
 		 SSDATA (comp_u->file));
 

src/process.c

@@ -1666,8 +1666,7 @@ Return nil if format of ADDRESS is invalid.  */)
 
   if (VECTORP (address))  /* AF_INET or AF_INET6 */
     {
-      register struct Lisp_Vector *p = XVECTOR (address);
-      ptrdiff_t size = p->header.size;
+      ptrdiff_t size = ASIZE (address);
       Lisp_Object args[10];
       int nargs, i;
       char const *format;
@@ -1700,15 +1699,15 @@ Return nil if format of ADDRESS is invalid.  */)
 
       for (i = 0; i < nargs; i++)
 	{
-	  if (! RANGED_FIXNUMP (0, p->contents[i], 65535))
+	  if (! RANGED_FIXNUMP (0, AREF (address, i), 65535))
 	    return Qnil;
 
 	  if (nargs <= 5         /* IPv4 */
 	      && i < 4           /* host, not port */
-	      && XFIXNUM (p->contents[i]) > 255)
+	      && XFIXNUM (AREF (address, i)) > 255)
 	    return Qnil;
 
-	  args[i + 1] = p->contents[i];
+	  args[i + 1] = AREF (address, i);
 	}
 
       return Fformat (nargs + 1, args);
@@ -2634,18 +2633,16 @@ conv_addrinfo_to_lisp (struct addrinfo *res)
 static ptrdiff_t
 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
 {
-  struct Lisp_Vector *p;
-
   if (VECTORP (address))
     {
-      p = XVECTOR (address);
-      if (p->header.size == 5)
+      ptrdiff_t size = ASIZE (address);
+      if (size == 5)
 	{
 	  *familyp = AF_INET;
 	  return sizeof (struct sockaddr_in);
 	}
 #ifdef AF_INET6
-      else if (p->header.size == 9)
+      else if (size == 9)
 	{
 	  *familyp = AF_INET6;
 	  return sizeof (struct sockaddr_in6);
@@ -2663,11 +2660,11 @@ get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
 	   && VECTORP (XCDR (address)))
     {
       struct sockaddr *sa;
-      p = XVECTOR (XCDR (address));
-      if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
+      Lisp_Object p = XCDR (address);
+      if (MAX_ALLOCA - sizeof sa->sa_family < ASIZE (p))
 	return 0;
       *familyp = XFIXNUM (XCAR (address));
-      return p->header.size + sizeof (sa->sa_family);
+      return ASIZE (p) + sizeof (sa->sa_family);
     }
   return 0;
 }

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)

src/window.c

@@ -7150,7 +7150,7 @@ the return value is nil.  Otherwise the value is t.  */)
 
       /* Don't do this within the main loop below: This may call Lisp
 	 code and is thus potentially unsafe while input is blocked.  */
-      for (k = 0; k < saved_windows->header.size; k++)
+      for (k = 0; k < VECTOR_ASIZE (saved_windows); k++)
 	{
 	  p = SAVED_WINDOW_N (saved_windows, k);
 	  window = p->window;
@@ -7205,7 +7205,7 @@ the return value is nil.  Otherwise the value is t.  */)
 	 dead.  */
       delete_all_child_windows (FRAME_ROOT_WINDOW (f));
 
-      for (k = 0; k < saved_windows->header.size; k++)
+      for (k = 0; k < VECTOR_ASIZE (saved_windows); k++)
 	{
 	  p = SAVED_WINDOW_N (saved_windows, k);
 	  window = p->window;
@@ -8269,10 +8269,10 @@ compare_window_configurations (Lisp_Object configuration1,
       || !EQ (d1->f_current_buffer, d2->f_current_buffer)
       || !EQ (d1->focus_frame, d2->focus_frame)
       /* Verify that the two configurations have the same number of windows.  */
-      || sws1->header.size != sws2->header.size)
+      || VECTOR_ASIZE (sws1) != VECTOR_ASIZE (sws2))
     return false;
 
-  for (i = 0; i < sws1->header.size; i++)
+  for (i = 0; i < VECTOR_ASIZE (sws1); i++)
     {
       struct saved_window *sw1, *sw2;
 

src/xdisp.c

@@ -5217,7 +5217,7 @@ setup_for_ellipsis (struct it *it, int len)
     {
       struct Lisp_Vector *v = XVECTOR (DISP_INVIS_VECTOR (it->dp));
       it->dpvec = v->contents;
-      it->dpend = v->contents + v->header.size;
+      it->dpend = v->contents + VECTOR_ASIZE(v);
     }
   else
     {
@@ -7953,11 +7953,11 @@ get_next_display_element (struct it *it)
 	      /* Return the first character from the display table
 		 entry, if not empty.  If empty, don't display the
 		 current character.  */
-	      if (v->header.size)
+	      if (VECTOR_ASIZE (v))
 		{
 		  it->dpvec_char_len = it->len;
 		  it->dpvec = v->contents;
-		  it->dpend = v->contents + v->header.size;
+		  it->dpend = v->contents + VECTOR_ASIZE (v);
 		  it->current.dpvec_index = 0;
 		  it->dpvec_face_id = -1;
 		  it->saved_face_id = it->face_id;
@@ -34458,7 +34458,7 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y)
 	{
 	  struct Lisp_Vector *v = XVECTOR (XCDR (hot_spot));
 	  Lisp_Object *poly = v->contents;
-	  ptrdiff_t n = v->header.size;
+	  ptrdiff_t n = VECTOR_ASIZE (v);
 	  ptrdiff_t i;
 	  bool inside = false;
 	  Lisp_Object lx, ly;

test/src/comp-resources/comp-test-funcs.el

@@ -708,6 +708,14 @@
   (when (= x 1.0e+INF)
     x))
 
+(defvar comp-test-literal-list '(1 2 3 4))
+(defvar comp-test-literal-vector [1 2 3 4])
+(defvar comp-test-literal-record #s(type 1 2 3 4))
+(defvar comp-test-literal-string "Foo")
+
+(defun comp-test-modify-const-list ()
+  (setcar comp-test-literal-list nil))
+
 (provide 'comp-test-funcs)
 
 ;;; comp-test-funcs.el ends here

test/src/comp-tests.el

@@ -759,6 +759,34 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
   (should (equal (comp-tests-cl-uninterned-arg-parse-f 1 2)
                  '(1 2))))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for statically compiled literals. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when (featurep 'comp--static-lisp-consts)
+  (comp-deftest static-lisp-consts ()
+   "Verify the compilation of self evaluating forms."
+   (let ((cases `((
+                   (setcar comp-test-literal-list nil)
+                   . ,comp-test-literal-list)
+                 ((aset comp-test-literal-vector 2 nil)
+                  . ,comp-test-literal-vector)
+                 ((aset comp-test-literal-record 2 nil)
+                  . ,comp-test-literal-record)
+                 ((aset comp-test-literal-string 1 ?c)
+                  . ,comp-test-literal-string)
+                 ((comp-test-modify-const-list)
+                  . ,comp-test-literal-list))))
+     (dolist (pair cases)
+       (let* ((form (car pair))
+             (obj (cdr pair))
+             (desc (should-error (eval form) :type 'error)))
+         (should (= (length desc) 3))
+         (should (eq (nth 0 desc) 'error))
+         (should (equal (nth 1 desc) "Attempt to modify read-only object"))
+         (should (eq (nth 2 desc) obj)))))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Middle-end specific tests. ;;