diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 38 |
1 files changed, 34 insertions, 4 deletions
diff --git a/src/alloc.c b/src/alloc.c index e0b2c220231..e01ea36e642 100644 --- 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; +} + /*********************************************************************** 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)) |