Don't purify in Fmake_byte_code.

* src/alloc.c (make_byte_code): New function.
(Fmake_byte_code): Use it.  Don't purify here.
* src/lread.c (read1): Use it as well to avoid extra allocation.

diff --git a/src/ChangeLog b/src/ChangeLog
index 1aba1913f469934d31b8f9a11d665b1ae5e3da06..dc2e6845c5098ef1b1eead76c66eb7f17b8995d2 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2012-06-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * alloc.c (make_byte_code): New function.
+       (Fmake_byte_code): Use it.  Don't purify here.
+       * lread.c (read1): Use it as well to avoid extra allocation.
+
 2012-06-11  Chong Yidong  <cyd@gnu.org>
 
        * image.c (imagemagick_load_image): Implement transparency.

diff --git a/src/alloc.c b/src/alloc.c
index da2b7ac4330684467ab99d2cd15a87ffe4aba20f..7051af9b99cdd217476540af15021d9ca5176da5 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3401,6 +3401,19 @@ usage: (vector &rest OBJECTS)  */)
   return val;
 }
 
+void
+make_byte_code (struct Lisp_Vector *v)
+{
+  if (v->header.size > 1 && STRINGP (v->contents[1])
+      && STRING_MULTIBYTE (v->contents[1]))
+    /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
+       earlier because they produced a raw 8-bit string for byte-code
+       and now such a byte-code string is loaded as multibyte while
+       raw 8-bit characters converted to multibyte form.  Thus, now we
+       must convert them back to the original unibyte form.  */
+    v->contents[1] = Fstring_as_unibyte (v->contents[1]);
+  XSETPVECTYPE (v, PVEC_COMPILED);
+}
 
 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
        doc: /* Create a byte-code object with specified arguments as elements.
@@ -3424,28 +3437,21 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
   ptrdiff_t i;
   register struct Lisp_Vector *p;
 
-  XSETFASTINT (len, nargs);
-  if (!NILP (Vpurify_flag))
-    val = make_pure_vector (nargs);
-  else
-    val = Fmake_vector (len, Qnil);
+  /* We used to purecopy everything here, if purify-flga 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
+     closures, so any closure built during the preload phase would end up
+     copied into pure space, including its free variables, which is sometimes
+     just wasteful and other times plainly wrong (e.g. those free vars may want
+     to be setcar'd).  */
 
-  if (nargs > 1 && STRINGP (args[1]) && STRING_MULTIBYTE (args[1]))
-    /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
-       earlier because they produced a raw 8-bit string for byte-code
-       and now such a byte-code string is loaded as multibyte while
-       raw 8-bit characters converted to multibyte form.  Thus, now we
-       must convert them back to the original unibyte form.  */
-    args[1] = Fstring_as_unibyte (args[1]);
+  XSETFASTINT (len, nargs);
+  val = Fmake_vector (len, Qnil);
 
   p = XVECTOR (val);
   for (i = 0; i < nargs; i++)
-    {
-      if (!NILP (Vpurify_flag))
-       args[i] = Fpurecopy (args[i]);
-      p->contents[i] = args[i];
-    }
-  XSETPVECTYPE (p, PVEC_COMPILED);
+    p->contents[i] = args[i];
+  make_byte_code (p);
   XSETCOMPILED (val, p);
   return val;
 }
@@ -3470,7 +3476,7 @@ union aligned_Lisp_Symbol
 
 /* Each symbol_block is just under 1020 bytes long, since malloc
    really allocates in units of powers of two and uses 4 bytes for its
-   own overhead. */
+   own overhead.  */
 
 #define SYMBOL_BLOCK_SIZE \
   ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))

diff --git a/src/lisp.h b/src/lisp.h
index acadcf5018358e99b82a6c0c9807e9ccb5196a91..9e108d950d3e26224f70cff89179b04a4373fd81 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2880,6 +2880,7 @@ extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int);
 extern Lisp_Object make_pure_c_string (const char *data);
 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
 EXFUN (Fgarbage_collect, 0);
+extern void make_byte_code (struct Lisp_Vector *);
 EXFUN (Fmake_byte_code, MANY);
 EXFUN (Fmake_bool_vector, 2);
 extern Lisp_Object Qchar_table_extra_slots;

diff --git a/src/lread.c b/src/lread.c
index 726f1f0e905aab4e52cfb1332d1c9b4a10756640..8a9088b8ed2c5ec530268ca0516dccde2314ee00 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -2551,8 +2551,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
             build them using function calls.  */
          Lisp_Object tmp;
          tmp = read_vector (readcharfun, 1);
-         return Fmake_byte_code (ASIZE (tmp),
-                                 XVECTOR (tmp)->contents);
+         make_byte_code (XVECTOR (tmp));
+         return tmp;
        }
       if (c == '(')
        {