Commit 3017f87f authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent 1b9b4cf4
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> 2012-06-11 Chong Yidong <cyd@gnu.org>
* image.c (imagemagick_load_image): Implement transparency. * image.c (imagemagick_load_image): Implement transparency.
......
...@@ -3401,6 +3401,19 @@ usage: (vector &rest OBJECTS) */) ...@@ -3401,6 +3401,19 @@ usage: (vector &rest OBJECTS) */)
return val; 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, DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements. 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 ...@@ -3424,28 +3437,21 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
ptrdiff_t i; ptrdiff_t i;
register struct Lisp_Vector *p; register struct Lisp_Vector *p;
XSETFASTINT (len, nargs); /* We used to purecopy everything here, if purify-flga was set. This worked
if (!NILP (Vpurify_flag)) OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
val = make_pure_vector (nargs); dangerous, since make-byte-code is used during execution to build
else closures, so any closure built during the preload phase would end up
val = Fmake_vector (len, Qnil); 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])) XSETFASTINT (len, nargs);
/* BYTECODE-STRING must have been produced by Emacs 20.2 or the val = Fmake_vector (len, Qnil);
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]);
p = XVECTOR (val); p = XVECTOR (val);
for (i = 0; i < nargs; i++) for (i = 0; i < nargs; i++)
{ p->contents[i] = args[i];
if (!NILP (Vpurify_flag)) make_byte_code (p);
args[i] = Fpurecopy (args[i]);
p->contents[i] = args[i];
}
XSETPVECTYPE (p, PVEC_COMPILED);
XSETCOMPILED (val, p); XSETCOMPILED (val, p);
return val; return val;
} }
...@@ -3470,7 +3476,7 @@ union aligned_Lisp_Symbol ...@@ -3470,7 +3476,7 @@ union aligned_Lisp_Symbol
/* Each symbol_block is just under 1020 bytes long, since malloc /* 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 really allocates in units of powers of two and uses 4 bytes for its
own overhead. */ own overhead. */
#define SYMBOL_BLOCK_SIZE \ #define SYMBOL_BLOCK_SIZE \
((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol)) ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
......
...@@ -2880,6 +2880,7 @@ extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int); ...@@ -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 make_pure_c_string (const char *data);
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
EXFUN (Fgarbage_collect, 0); EXFUN (Fgarbage_collect, 0);
extern void make_byte_code (struct Lisp_Vector *);
EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_byte_code, MANY);
EXFUN (Fmake_bool_vector, 2); EXFUN (Fmake_bool_vector, 2);
extern Lisp_Object Qchar_table_extra_slots; extern Lisp_Object Qchar_table_extra_slots;
......
...@@ -2551,8 +2551,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) ...@@ -2551,8 +2551,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
build them using function calls. */ build them using function calls. */
Lisp_Object tmp; Lisp_Object tmp;
tmp = read_vector (readcharfun, 1); tmp = read_vector (readcharfun, 1);
return Fmake_byte_code (ASIZE (tmp), make_byte_code (XVECTOR (tmp));
XVECTOR (tmp)->contents); return tmp;
} }
if (c == '(') if (c == '(')
{ {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment