From 3017f87fbd0461b9460e7261a095fc86e166b30e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 Jun 2012 11:13:27 -0400 Subject: [PATCH] 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 | 6 ++++++ src/alloc.c | 44 +++++++++++++++++++++++++------------------- src/lisp.h | 1 + src/lread.c | 4 ++-- 4 files changed, 34 insertions(+), 21 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 1aba1913f46..dc2e6845c50 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-06-11 Stefan Monnier + + * 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 * image.c (imagemagick_load_image): Implement transparency. diff --git a/src/alloc.c b/src/alloc.c index da2b7ac4330..7051af9b99c 100644 --- 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 acadcf50183..9e108d950d3 100644 --- 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 726f1f0e905..8a9088b8ed2 100644 --- 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 == '(') { -- 2.11.4.GIT