Pin bytecode strings to avoid copy at call time

Avoid making a copy (in the interpreter C stack frame) of the bytecode
string by making sure it won't be moved by the GC.  This is done by
reallocating it to the heap normally only used for large strings,
which isn't compacted.

This requires that we retain an explicit reference to the bytecode
string object (`bytestr`) lest it be GCed away should all other
references vanish during execution.  We allocate an extra stack slot
for that, as we already do for the constant vector object.

* src/alloc.c (allocate_string_data): Add `immovable` argument.
(resize_string_data, make_clear_multibyte_string): Use it.
(pin_string): New.
* src/pdumper.c (dump_string): Fix incorrect comment.
Update hash for Lisp_String (only comments changed, not contents).
* src/lread.c (read1):
* src/alloc.c (Fmake_byte_code, purecopy):
* src/bytecode.c (Fbyte_code): Pin bytecode on object creation.
(exec_byte_code): Don't copy bytecode.  Retain `bytestr` explicitly.
* src/lisp.h (Lisp_String): Explain special size_byte values.
(string_immovable_p): New.

diff --git a/src/alloc.c b/src/alloc.c
index e0b2c2202316f3f902195e6853114d46b33a9ae5..e01ea36e642e8c72124595f3d249dd714c42b1ba 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1853,7 +1853,8 @@ allocate_string (void)
 
 static void
 allocate_string_data (struct Lisp_String *s,
-                     EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
+                     EMACS_INT nchars, EMACS_INT nbytes, bool clearit,
+                     bool immovable)
 {
   sdata *data;
   struct sblock *b;
@@ -1867,7 +1868,7 @@ allocate_string_data (struct Lisp_String *s,
 
   MALLOC_BLOCK_INPUT;
 
-  if (nbytes > LARGE_STRING_BYTES)
+  if (nbytes > LARGE_STRING_BYTES || immovable)
     {
       size_t size = FLEXSIZEOF (struct sblock, data, needed);
 
@@ -1967,7 +1968,7 @@ resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
     }
   else
     {
-      allocate_string_data (XSTRING (string), nchars, new_nbytes, false);
+      allocate_string_data (XSTRING (string), nchars, new_nbytes, false, false);
       unsigned char *new_data = SDATA (string);
       new_charaddr = new_data + cidx_byte;
       memcpy (new_charaddr + new_clen, data + cidx_byte + clen,
@@ -2483,7 +2484,7 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
 
   s = allocate_string ();
   s->u.s.intervals = NULL;
-  allocate_string_data (s, nchars, nbytes, clearit);
+  allocate_string_data (s, nchars, nbytes, clearit, false);
   XSETSTRING (string, s);
   string_chars_consed += nbytes;
   return string;
@@ -2513,6 +2514,29 @@ make_formatted_string (char *buf, const char *format, ...)
   return make_string (buf, length);
 }
 
+/* Pin a unibyte string in place so that it won't move during GC.  */
+void
+pin_string (Lisp_Object string)
+{
+  eassert (STRINGP (string) && !STRING_MULTIBYTE (string));
+  struct Lisp_String *s = XSTRING (string);
+  ptrdiff_t size = STRING_BYTES (s);
+  unsigned char *data = s->u.s.data;
+
+  if (!(size > LARGE_STRING_BYTES
+       || PURE_P (data) || pdumper_object_p (data)
+       || s->u.s.size_byte == -3))
+    {
+      eassert (s->u.s.size_byte == -1);
+      sdata *old_sdata = SDATA_OF_STRING (s);
+      allocate_string_data (s, size, size, false, true);
+      memcpy (s->u.s.data, data, size);
+      old_sdata->string = NULL;
+      SDATA_NBYTES (old_sdata) = size;
+    }
+  s->u.s.size_byte = -3;
+}
+
 \f
 /***********************************************************************
                           Float Allocation
@@ -3515,6 +3539,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
         && FIXNATP (args[COMPILED_STACK_DEPTH])))
     error ("Invalid byte-code object");
 
+  pin_string (args[COMPILED_BYTECODE]);  // Bytecode must be immovable.
+
   /* We used to purecopy everything here, if purify-flag was set.  This worked
      OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
      dangerous, since make-byte-code is used during execution to build
@@ -5653,6 +5679,10 @@ purecopy (Lisp_Object obj)
       memcpy (vec, objp, nbytes);
       for (i = 0; i < size; i++)
        vec->contents[i] = purecopy (vec->contents[i]);
+      // Byte code strings must be pinned.
+      if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1])
+         && !STRING_MULTIBYTE (vec->contents[1]))
+       pin_string (vec->contents[1]);
       XSETVECTOR (obj, vec);
     }
   else if (BARE_SYMBOL_P (obj))

diff --git a/src/bytecode.c b/src/bytecode.c
index 37da0858ab4fd621b3a31d54cfb883b573c989df..0d0a28cd0bbdf808e31543e05a59e4e0f1a940c1 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -331,6 +331,7 @@ If the third argument is incorrect, Emacs may crash.  */)
         the original unibyte form.  */
       bytestr = Fstring_as_unibyte (bytestr);
     }
+  pin_string (bytestr);  // Bytecode must be immovable.
 
   return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
 }
@@ -358,22 +359,28 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 #endif
 
   eassert (!STRING_MULTIBYTE (bytestr));
+  eassert (string_immovable_p (bytestr));
 
   ptrdiff_t const_length = ASIZE (vector);
   ptrdiff_t bytestr_length = SCHARS (bytestr);
   Lisp_Object *vectorp = XVECTOR (vector)->contents;
 
   unsigned char quitcounter = 1;
-  EMACS_INT stack_items = XFIXNAT (maxdepth) + 1;
+  /* Allocate two more slots than required, because... */
+  EMACS_INT stack_items = XFIXNAT (maxdepth) + 2;
   USE_SAFE_ALLOCA;
   void *alloc;
-  SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length);
+  SAFE_ALLOCA_LISP (alloc, stack_items);
   Lisp_Object *stack_base = alloc;
-  Lisp_Object *top = stack_base;
-  *top = vector; /* Ensure VECTOR survives GC (Bug#33014).  */
-  Lisp_Object *stack_lim = stack_base + stack_items;
-  unsigned char const *bytestr_data = memcpy (stack_lim,
-                                             SDATA (bytestr), bytestr_length);
+  /* ... we plonk BYTESTR and VECTOR there to ensure that they survive
+     GC (bug#33014), since these variables aren't used directly beyond
+     the interpreter prologue and wouldn't be found in the stack frame
+     otherwise.  */
+  stack_base[0] = bytestr;
+  stack_base[1] = vector;
+  Lisp_Object *top = stack_base + 1;
+  Lisp_Object *stack_lim = top + stack_items;
+  unsigned char const *bytestr_data = SDATA (bytestr);
   unsigned char const *pc = bytestr_data;
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -1564,6 +1571,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 
  exit:
 
+  eassert (SDATA (bytestr) == bytestr_data);
+
   /* Binds and unbinds are supposed to be compiled balanced.  */
   if (SPECPDL_INDEX () != count)
     {

diff --git a/src/lisp.h b/src/lisp.h
index 020fe6e0943335ce895db087c61f1b1ac65c6665..fdcb7f39d59c8a72613276de0f9c0044e653feb4 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1554,7 +1554,9 @@ struct Lisp_String
     struct
     {
       ptrdiff_t size;           /* MSB is used as the markbit.  */
-      ptrdiff_t size_byte;      /* Set to -1 for unibyte strings.  */
+      ptrdiff_t size_byte;      /* Set to -1 for unibyte strings,
+                                  -2 for data in rodata,
+                                  -3 for immovable unibyte strings.  */
       INTERVAL intervals;      /* Text properties in this string.  */
       unsigned char *data;
     } s;
@@ -1702,6 +1704,13 @@ CHECK_STRING_NULL_BYTES (Lisp_Object string)
              Qfilenamep, string);
 }
 
+/* True if STR is immovable (whose data won't move during GC).  */
+INLINE bool
+string_immovable_p (Lisp_Object str)
+{
+  return XSTRING (str)->u.s.size_byte == -3;
+}
+
 /* A regular vector is just a header plus an array of Lisp_Objects.  */
 
 struct Lisp_Vector
@@ -4048,6 +4057,7 @@ extern Lisp_Object make_specified_string (const char *,
                                          ptrdiff_t, ptrdiff_t, bool);
 extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
 extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
+extern void pin_string (Lisp_Object string);
 
 /* Make a string allocated in pure space, use STR as string data.  */
 

diff --git a/src/lread.c b/src/lread.c
index 4ec1df672c7738b52f49a80b606cd7251203f3e4..9910db27de7c9c25df821962bef45ce3dc23eb55 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -3237,16 +3237,20 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
                 && FIXNATP (AREF (tmp, COMPILED_STACK_DEPTH))))
            invalid_syntax ("Invalid byte-code object", readcharfun);
 
-         if (STRINGP (AREF (tmp, COMPILED_BYTECODE))
-             && STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
+         if (STRINGP (AREF (tmp, COMPILED_BYTECODE)))
            {
-             /* BYTESTR must have been produced by Emacs 20.2 or earlier
-                because it produced a raw 8-bit string for byte-code and
-                now such a byte-code string is loaded as multibyte with
-                raw 8-bit characters converted to multibyte form.
-                Convert them back to the original unibyte form.  */
-             ASET (tmp, COMPILED_BYTECODE,
-                   Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE)));
+             if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
+               {
+                 /* BYTESTR must have been produced by Emacs 20.2 or earlier
+                    because it produced a raw 8-bit string for byte-code and
+                    now such a byte-code string is loaded as multibyte with
+                    raw 8-bit characters converted to multibyte form.
+                    Convert them back to the original unibyte form.  */
+                 ASET (tmp, COMPILED_BYTECODE,
+                       Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE)));
+               }
+             // Bytecode must be immovable.
+             pin_string (AREF (tmp, COMPILED_BYTECODE));
            }
 
          XSETPVECTYPE (vec, PVEC_COMPILED);

diff --git a/src/pdumper.c b/src/pdumper.c
index eeebb7ed0e8cf549a001d07a25ffa0f48e701e54..60280fcb043f7cab355f64d68c8d86d760d8ccc5 100644 (file)
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2068,7 +2068,7 @@ dump_interval_tree (struct dump_context *ctx,
 static dump_off
 dump_string (struct dump_context *ctx, const struct Lisp_String *string)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352)
 # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
 #endif
   /* If we have text properties, write them _after_ the string so that
@@ -2079,7 +2079,7 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string)
      we seldom write to string data and never relocate it, so lumping
      it together at the end of the dump saves on COW faults.
 
-     If, however, the string's size_byte field is -1, the string data
+     If, however, the string's size_byte field is -2, the string data
      is actually a pointer to Emacs data segment, so we can do even
      better by emitting a relocation instead of bothering to copy the
      string data.  */