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.

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.

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))

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;

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 == '(')
 	{