From b9598260f96ddc652cd82ab64bbe922ccfc48a29 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Jun 2010 16:36:17 -0400 Subject: New branch for lexbind, losing all history. This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original lexbind branch. --- src/ChangeLog.funvec | 37 +++++ src/ChangeLog.lexbind | 104 ++++++++++++++ src/alloc.c | 76 +++++++++- src/buffer.c | 1 + src/bytecode.c | 128 ++++++++++++++++- src/data.c | 28 +++- src/doc.c | 11 +- src/eval.c | 377 +++++++++++++++++++++++++++++++++++++++++++++----- src/fns.c | 25 ++-- src/image.c | 2 +- src/keyboard.c | 2 +- src/lisp.h | 44 +++++- src/lread.c | 194 ++++++++++++++++++++++++-- src/print.c | 6 +- 14 files changed, 945 insertions(+), 90 deletions(-) create mode 100644 src/ChangeLog.funvec create mode 100644 src/ChangeLog.lexbind (limited to 'src') diff --git a/src/ChangeLog.funvec b/src/ChangeLog.funvec new file mode 100644 index 00000000000..098539f1dd9 --- /dev/null +++ b/src/ChangeLog.funvec @@ -0,0 +1,37 @@ +2004-05-20 Miles Bader + + * lisp.h: Declare make_funvec and Ffunvec. + (enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'. + (XSETFUNVEC): Renamed from `XSETCOMPILED'. + (FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros. + (COMPILEDP): Define in terms of funvec macros. + (FUNVECP, GC_FUNVECP): Renamed from `COMPILEDP' & `GC_COMPILEDP'. + (FUNCTIONP): Use FUNVECP instead of COMPILEDP. + * alloc.c (make_funvec, funvec): New functions. + (Fmake_byte_code): Make sure the first element is a list. + + * eval.c (Qcurry): New variable. + (funcall_funvec, Fcurry): New functions. + (syms_of_eval): Initialize them. + (funcall_lambda): Handle non-bytecode funvec objects by calling + funcall_funvec. + (Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP. + * lread.c (read1): Return result of read_vector for `#[' syntax + directly; read_vector now does any extra work required. + (read_vector): Handle both funvec and byte-code objects, converting the + type as necessary. `bytecodeflag' argument is now called + `read_funvec'. + * data.c (Ffunvecp): New function. + * doc.c (Fdocumentation): Return nil for unknown funvecs. + * fns.c (mapcar1, Felt, concat): Allow funvecs. + + * eval.c (Ffunctionp): Use `funvec' operators instead of `compiled' + operators. + * alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise. + * keyboard.c (Fcommand_execute): Likewise. + * image.c (parse_image_spec): Likewise. + * fns.c (Flength, concat, internal_equal): Likewise. + * data.c (Faref, Ftype_of): Likewise. + * print.c (print_preprocess, print_object): Likewise. + +;; arch-tag: f35a6a00-4a11-4739-a4b6-9cf98296f315 diff --git a/src/ChangeLog.lexbind b/src/ChangeLog.lexbind new file mode 100644 index 00000000000..c8336d12e9c --- /dev/null +++ b/src/ChangeLog.lexbind @@ -0,0 +1,104 @@ +2008-04-23 Miles Bader + + * eval.c (Ffunctionp): Return nil for special forms. + (Qunevalled): New variable. + (syms_of_eval): Initialize it. + +2007-10-18 Miles Bader + + * eval.c (FletX): Test the type of VARLIST rather than just !NILP. + (Flet): Use XCAR instead of Fcar. + +2007-10-16 Miles Bader + + * alloc.c (make_funvec, Fpurecopy): Set the pseudo-vector type. + +2006-02-10 Miles Bader + + * eval.c (Ffunctionp): Supply new 2nd arg to Findirect_function. + +2005-03-04 Miles Bader + + * eval.c (FletX): Update Vinterpreter_lexical_environment for each + variable we bind, instead of all at once like `let'. + +2004-08-09 Miles Bader + + Changes from merging the funvec patch: + + * eval.c (Feval, Ffuncall): Don't special-case vectors. + (funcall_lambda): Use FUNVEC_SIZE. + (Fcurry): Remove function. + + Merge funvec patch. + +2004-04-10 Miles Bader + + * eval.c (Fspecialp): New function. + (syms_of_eval): Initialize it. + +2004-04-03 Miles Bader + + * eval.c (Feval): If a variable isn't bound lexically, fall back + to looking it up dynamically even if it isn't declared special. + +2002-08-26 Miles Bader + + * bytecode.c (Fbyte_code): Fsub1 can GC, so protect it. + +2002-06-12 Miles Bader + + Lexical binding changes to the byte-code interpreter: + + * bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, Bvec_ref, Bvec_set) + (BdiscardN): New constants. + (exec_byte_code): Renamed from `Fbyte_code'. + Implement above new bytecodes. + Add ARGS-TEMPLATE, NARGS and ARGS parameters, and optionally use + them push initial args on the stack. + (Fbyte_code): New function, just call `exec_byte_code'. + Add additional optional arguments for `exec_byte_code'. + (Qand_optional, Qand_rest): New extern declarations. + * eval.c (Fcurry, Ffunctionp): New functions. + (syms_of_eval): Initialize them. + (funcall_lambda): Call `exec_byte_code' instead of Fbyte_code. + If a compiled-function object has a `push-args' slot, call the + byte-code interpreter without binding any arguments. + (Ffuncall): Add support for curried functions. + * lisp.h (Fbyte_code): Declare max-args as MANY. + (exec_byte_code): New declaration. + + Lexical binding changes to the lisp interpreter: + + * lisp.h (struct Lisp_Symbol): Add `declared_special' field. + (apply_lambda): Add new 3rd arg to decl. + * alloc.c (Fmake_symbol): Initialize `declared_special' field. + * eval.c (Vinterpreter_lexical_environment): New variable. + (syms_of_eval): Initialize it. + (Fsetq): Modify SYM's lexical binding if appropriate. + (Ffunction): Return a closure if within a lexical environment. + (Flet, FletX): Lexically bind non-defvar'd variables if inside a + lexical environment. + (Feval): Return lexical binding of variables, if they have one. + Pass current lexical environment to embedded lambdas. Handle closures. + (Ffuncall): Pass nil lexical environment to lambdas. Handle closures. + (funcall_lambda): Add new LEXENV argument, and lexically bind + arguments if it's non-nil. Bind `interpreter-lexenv' if it changed. + (apply_lambda): Add new LEXENV argument and pass it to funcall_lambda. + (Fdefvaralias, Fdefvar, Fdefconst): Mark the variable as special. + (Qinternal_interpreter_environment, Qclosure): New constants. + (syms_of_eval): Initialize them. + (Fdefun, Fdefmacro): Use a closure if lexical binding is active. + * lread.c (defvar_bool, defvar_lisp_nopro, defvar_per_buffer) + (defvar_kboard, defvar_int): Mark the variable as special. + (Vlexical_binding, Qlexical_binding): New variables. + (syms_of_lread): Initialize them. + (Fload): Bind `lexically-bound' to nil unless specified otherwise + in the file header. + (lisp_file_lexically_bound_p): New function. + (Qinternal_interpreter_environment): New variable. + * doc.c (Qclosure): New extern declaration. + (Fdocumentation, store_function_docstring): Handle interpreted + closures. + +;; arch-tag: 7cf884aa-6b48-40cb-bfca-265a1e99b3c5 diff --git a/src/alloc.c b/src/alloc.c index e0f07cc5f5a..a23c688043c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3042,6 +3042,39 @@ See also the function `vector'. */) } +/* Return a new `function vector' containing KIND as the first element, + followed by NUM_NIL_SLOTS nil elements, and further elements copied from + the vector PARAMS of length NUM_PARAMS (so the total length of the + resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS). + + If NUM_PARAMS is zero, then PARAMS may be NULL. + + A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. + See the function `funvec' for more detail. */ + +Lisp_Object +make_funvec (kind, num_nil_slots, num_params, params) + Lisp_Object kind; + int num_nil_slots, num_params; + Lisp_Object *params; +{ + int param_index; + Lisp_Object funvec; + + funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil); + + ASET (funvec, 0, kind); + + for (param_index = 0; param_index < num_params; param_index++) + ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]); + + XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC); + XSETFUNVEC (funvec, XVECTOR (funvec)); + + return funvec; +} + + DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -3063,6 +3096,29 @@ usage: (vector &rest OBJECTS) */) } +DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0, + doc: /* Return a newly created `function vector' of type KIND. +A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. +KIND indicates the kind of funvec, and determines its behavior when called. +The meaning of the remaining arguments depends on KIND. Currently +implemented values of KIND, and their meaning, are: + + A list -- A byte-compiled function. See `make-byte-code' for the usual + way to create byte-compiled functions. + + `curry' -- A curried function. Remaining arguments are a function to + call, and arguments to prepend to user arguments at the + time of the call; see the `curry' function. + +usage: (funvec KIND &rest PARAMS) */) + (nargs, args) + register int nargs; + Lisp_Object *args; +{ + return make_funvec (args[0], 0, nargs - 1, args + 1); +} + + DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the arglist, bytecode-string, constant vector, @@ -3078,6 +3134,10 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT register int index; register struct Lisp_Vector *p; + /* Make sure the arg-list is really a list, as that's what's used to + distinguish a byte-compiled object from other funvecs. */ + CHECK_LIST (args[0]); + XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) val = make_pure_vector ((EMACS_INT) nargs); @@ -3099,8 +3159,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } - XSETPVECTYPE (p, PVEC_COMPILED); - XSETCOMPILED (val, p); + XSETPVECTYPE (p, PVEC_FUNVEC); + XSETFUNVEC (val, p); return val; } @@ -3199,6 +3259,7 @@ Its value and function definition are void, and its property list is nil. */) p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; p->constant = 0; + p->declared_special = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; @@ -4907,7 +4968,7 @@ Does not copy symbols. Copies strings without text properties. */) obj = make_pure_string (SDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj)); - else if (COMPILEDP (obj) || VECTORP (obj)) + else if (FUNVECP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register int i; @@ -4919,10 +4980,10 @@ Does not copy symbols. Copies strings without text properties. */) vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); - if (COMPILEDP (obj)) + if (FUNVECP (obj)) { - XSETPVECTYPE (vec, PVEC_COMPILED); - XSETCOMPILED (obj, vec); + XSETPVECTYPE (vec, PVEC_FUNVEC); + XSETFUNVEC (obj, vec); } else XSETVECTOR (obj, vec); @@ -5512,7 +5573,7 @@ mark_object (arg) } else if (SUBRP (obj)) break; - else if (COMPILEDP (obj)) + else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -6423,6 +6484,7 @@ The time is in seconds as a floating point value. */); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); + defsubr (&Sfunvec); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); diff --git a/src/buffer.c b/src/buffer.c index 589266f40e5..e907c295e8d 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5418,6 +5418,7 @@ defvar_per_buffer (bo_fwd, namestring, address, type, doc) bo_fwd->type = Lisp_Fwd_Buffer_Obj; bo_fwd->offset = offset; bo_fwd->slottype = type; + sym->declared_special = 1; sym->redirect = SYMBOL_FORWARDED; { /* I tried to do the job without a cast, but it seems impossible. diff --git a/src/bytecode.c b/src/bytecode.c index c53c5acdbb3..fec855c0b83 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -87,9 +87,11 @@ int byte_metering_on; Lisp_Object Qbytecode; +extern Lisp_Object Qand_optional, Qand_rest; /* Byte codes: */ +#define Bstack_ref 0 #define Bvarref 010 #define Bvarset 020 #define Bvarbind 030 @@ -229,6 +231,13 @@ Lisp_Object Qbytecode; #define BconcatN 0260 #define BinsertN 0261 +/* Bstack_ref is code 0. */ +#define Bstack_set 0262 +#define Bstack_set2 0263 +#define Bvec_ref 0264 +#define Bvec_set 0265 +#define BdiscardN 0266 + #define Bconstant 0300 #define CONSTANTLIM 0100 @@ -397,14 +406,41 @@ unmark_byte_stack () } while (0) -DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, +DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0, doc: /* Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; the second, VECTOR, a vector of constants; the third, MAXDEPTH, the maximum stack depth used in this function. -If the third argument is incorrect, Emacs may crash. */) - (bytestr, vector, maxdepth) - Lisp_Object bytestr, vector, maxdepth; +If the third argument is incorrect, Emacs may crash. + +If ARGS-TEMPLATE is specified, it is an argument list specification, +according to which any remaining arguments are pushed on the stack +before executing BYTESTR. + +usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil; + int pnargs = nargs >= 4 ? nargs - 4 : 0; + Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0; + return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs); +} + +/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and + MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, + emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp + argument list (including &rest, &optional, etc.), and ARGS, of size + NARGS, should be a vector of the actual arguments. The arguments in + ARGS are pushed on the stack according to ARGS_TEMPLATE before + executing BYTESTR. */ + +Lisp_Object +exec_byte_code (bytestr, vector, maxdepth, args_template, nargs, args) + Lisp_Object bytestr, vector, maxdepth, args_template; + int nargs; + Lisp_Object *args; { int count = SPECPDL_INDEX (); #ifdef BYTE_CODE_METER @@ -462,6 +498,37 @@ If the third argument is incorrect, Emacs may crash. */) stacke = stack.bottom - 1 + XFASTINT (maxdepth); #endif + if (! NILP (args_template)) + /* We should push some arguments on the stack. */ + { + Lisp_Object at; + int pushed = 0, optional = 0; + + for (at = args_template; CONSP (at); at = XCDR (at)) + if (EQ (XCAR (at), Qand_optional)) + optional = 1; + else if (EQ (XCAR (at), Qand_rest)) + { + PUSH (Flist (nargs, args)); + pushed = nargs; + at = Qnil; + break; + } + else if (pushed < nargs) + { + PUSH (*args++); + pushed++; + } + else if (optional) + PUSH (Qnil); + else + break; + + if (pushed != nargs || !NILP (at)) + Fsignal (Qwrong_number_of_arguments, + Fcons (args_template, Fcons (make_number (nargs), Qnil))); + } + while (1) { #ifdef BYTE_CODE_SAFE @@ -1641,8 +1708,57 @@ If the third argument is incorrect, Emacs may crash. */) break; #endif - case 0: - abort (); + /* Handy byte-codes for lexical binding. */ + case Bstack_ref: + case Bstack_ref+1: + case Bstack_ref+2: + case Bstack_ref+3: + case Bstack_ref+4: + case Bstack_ref+5: + PUSH (stack.bottom[op - Bstack_ref]); + break; + case Bstack_ref+6: + PUSH (stack.bottom[FETCH]); + break; + case Bstack_ref+7: + PUSH (stack.bottom[FETCH2]); + break; + case Bstack_set: + stack.bottom[FETCH] = POP; + break; + case Bstack_set2: + stack.bottom[FETCH2] = POP; + break; + case Bvec_ref: + case Bvec_set: + /* These byte-codes used mostly for variable references to + lexically bound variables that are in an environment vector + instead of on the byte-interpreter stack (generally those + variables which might be shared with a closure). */ + { + int index = FETCH; + Lisp_Object vec = POP; + + if (! VECTORP (vec)) + wrong_type_argument (Qvectorp, vec); + else if (index < 0 || index >= XVECTOR (vec)->size) + args_out_of_range (vec, index); + + if (op == Bvec_ref) + PUSH (XVECTOR (vec)->contents[index]); + else + XVECTOR (vec)->contents[index] = POP; + } + break; + case BdiscardN: + op = FETCH; + if (op & 0x80) + { + op &= 0x7F; + top[-op] = TOP; + } + DISCARD (op); + break; case 255: default: diff --git a/src/data.c b/src/data.c index 93cc57e9f2c..6a21ad44720 100644 --- a/src/data.c +++ b/src/data.c @@ -84,7 +84,7 @@ Lisp_Object Qinteger; static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; Lisp_Object Qprocess; -static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; +static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; @@ -219,8 +219,11 @@ for example, (type-of 1) returns `integer'. */) return Qwindow; if (SUBRP (object)) return Qsubr; - if (COMPILEDP (object)) - return Qcompiled_function; + if (FUNVECP (object)) + if (FUNVEC_COMPILED_P (object)) + return Qcompiled_function; + else + return Qfunction_vector; if (BUFFERP (object)) return Qbuffer; if (CHAR_TABLE_P (object)) @@ -437,6 +440,14 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, return Qnil; } +DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0, + doc: /* Return t if OBJECT is a `function vector' object. */) + (object) + Lisp_Object object; +{ + return FUNVECP (object) ? Qt : Qnil; +} + DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, doc: /* Return t if OBJECT is a character or a string. */) (object) @@ -2208,15 +2219,15 @@ or a byte-code object. IDX starts at 0. */) { int size = 0; if (VECTORP (array)) - size = XVECTOR (array)->size; - else if (COMPILEDP (array)) - size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK; + size = ASIZE (array); + else if (FUNVECP (array)) + size = FUNVEC_SIZE (array); else wrong_type_argument (Qarrayp, array); if (idxval < 0 || idxval >= size) args_out_of_range (array, idx); - return XVECTOR (array)->contents[idxval]; + return AREF (array, idxval); } } @@ -3326,6 +3337,7 @@ syms_of_data () Qwindow = intern_c_string ("window"); /* Qsubr = intern_c_string ("subr"); */ Qcompiled_function = intern_c_string ("compiled-function"); + Qfunction_vector = intern_c_string ("function-vector"); Qbuffer = intern_c_string ("buffer"); Qframe = intern_c_string ("frame"); Qvector = intern_c_string ("vector"); @@ -3351,6 +3363,7 @@ syms_of_data () staticpro (&Qwindow); /* staticpro (&Qsubr); */ staticpro (&Qcompiled_function); + staticpro (&Qfunction_vector); staticpro (&Qbuffer); staticpro (&Qframe); staticpro (&Qvector); @@ -3387,6 +3400,7 @@ syms_of_data () defsubr (&Smarkerp); defsubr (&Ssubrp); defsubr (&Sbyte_code_function_p); + defsubr (&Sfunvecp); defsubr (&Schar_or_string_p); defsubr (&Scar); defsubr (&Scdr); diff --git a/src/doc.c b/src/doc.c index 536d22c57a6..9133c2e6b84 100644 --- a/src/doc.c +++ b/src/doc.c @@ -56,7 +56,7 @@ Lisp_Object Qfunction_documentation; /* A list of files used to build this Emacs binary. */ static Lisp_Object Vbuild_files; -extern Lisp_Object Voverriding_local_map; +extern Lisp_Object Voverriding_local_map, Qclosure; extern Lisp_Object Qremap; @@ -385,6 +385,11 @@ string is passed through `substitute-command-keys'. */) else return Qnil; } + else if (FUNVECP (fun)) + { + /* Unless otherwise handled, funvecs have no documentation. */ + return Qnil; + } else if (STRINGP (fun) || VECTORP (fun)) { return build_string ("Keyboard macro."); @@ -412,6 +417,8 @@ string is passed through `substitute-command-keys'. */) else return Qnil; } + else if (EQ (funcar, Qclosure)) + return Fdocumentation (Fcdr (XCDR (fun)), raw); else if (EQ (funcar, Qmacro)) return Fdocumentation (Fcdr (fun), raw); else @@ -542,6 +549,8 @@ store_function_docstring (fun, offset) } else if (EQ (tem, Qmacro)) store_function_docstring (XCDR (fun), offset); + else if (EQ (tem, Qclosure)) + store_function_docstring (Fcdr (XCDR (fun)), offset); } /* Bytecode objects sometimes have slots for it. */ diff --git a/src/eval.c b/src/eval.c index 199c4705736..875b4498a61 100644 --- a/src/eval.c +++ b/src/eval.c @@ -62,6 +62,9 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; +Lisp_Object Qcurry, Qunevalled; +Lisp_Object Qinternal_interpreter_environment, Qclosure; + Lisp_Object Qdebug; extern Lisp_Object Qinteractive_form; @@ -78,6 +81,13 @@ Lisp_Object Vrun_hooks; Lisp_Object Vautoload_queue; +/* When lexical binding is being used, this is non-nil, and contains an + alist of lexically-bound variable, or t, indicating an empty + environment. The lisp name of this variable is + `internal-interpreter-lexical-environment'. */ + +Lisp_Object Vinternal_interpreter_environment; + /* Current number of specbindings allocated in specpdl. */ int specpdl_size; @@ -167,10 +177,11 @@ int handling_signal; Lisp_Object Vmacro_declaration_function; extern Lisp_Object Qrisky_local_variable; - extern Lisp_Object Qfunction; -static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); +static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object *, + Lisp_Object)); + static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN; #if __GNUC__ @@ -504,7 +515,7 @@ usage: (setq [SYM VAL]...) */) Lisp_Object args; { register Lisp_Object args_left; - register Lisp_Object val, sym; + register Lisp_Object val, sym, lex_binding; struct gcpro gcpro1; if (NILP (args)) @@ -517,7 +528,15 @@ usage: (setq [SYM VAL]...) */) { val = Feval (Fcar (Fcdr (args_left))); sym = Fcar (args_left); - Fset (sym, val); + + if (!NILP (Vinternal_interpreter_environment) + && SYMBOLP (sym) + && !XSYMBOL (sym)->declared_special + && !NILP (lex_binding = Fassq (sym, Vinternal_interpreter_environment))) + XSETCDR (lex_binding, val); /* SYM is lexically bound. */ + else + Fset (sym, val); /* SYM is dynamically bound. */ + args_left = Fcdr (Fcdr (args_left)); } while (!NILP(args_left)); @@ -545,9 +564,20 @@ usage: (function ARG) */) (args) Lisp_Object args; { + Lisp_Object quoted = XCAR (args); + if (!NILP (Fcdr (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); - return Fcar (args); + + if (!NILP (Vinternal_interpreter_environment) + && CONSP (quoted) + && EQ (XCAR (quoted), Qlambda)) + /* This is a lambda expression within a lexical environment; + return an interpreted closure instead of a simple lambda. */ + return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted)); + else + /* Simply quote the argument. */ + return quoted; } @@ -570,7 +600,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii) use `called-interactively-p'. */) () { - return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; + return interactive_p (1) ? Qt : Qnil; } @@ -666,6 +696,8 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) fn_name = Fcar (args); CHECK_SYMBOL (fn_name); defn = Fcons (Qlambda, Fcdr (args)); + if (! NILP (Vinternal_interpreter_environment)) + defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn)); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); if (CONSP (XSYMBOL (fn_name)->function) @@ -738,7 +770,11 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, tail); else tail = Fcons (lambda_list, Fcons (doc, tail)); - defn = Fcons (Qmacro, Fcons (Qlambda, tail)); + + defn = Fcons (Qlambda, tail); + if (! NILP (Vinternal_interpreter_environment)) + defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn)); + defn = Fcons (Qmacro, defn); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); @@ -799,6 +835,7 @@ The return value is BASE-VARIABLE. */) error ("Don't know how to make a let-bound variable an alias"); } + sym->declared_special = 1; sym->redirect = SYMBOL_VARALIAS; SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); sym->constant = SYMBOL_CONSTANT_P (base_variable); @@ -889,6 +926,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) It could get in the way of other definitions, and unloading this package could try to make the variable unbound. */ ; + + if (SYMBOLP (sym)) + XSYMBOL (sym)->declared_special = 1; return sym; } @@ -918,6 +958,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); + XSYMBOL (sym)->declared_special = 1; tem = Fcar (Fcdr (Fcdr (args))); if (!NILP (tem)) { @@ -1006,30 +1047,50 @@ usage: (let* VARLIST BODY...) */) (args) Lisp_Object args; { - Lisp_Object varlist, val, elt; + Lisp_Object varlist, var, val, elt, lexenv; int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3; GCPRO3 (args, elt, varlist); + lexenv = Vinternal_interpreter_environment; + varlist = Fcar (args); - while (!NILP (varlist)) + while (CONSP (varlist)) { QUIT; - elt = Fcar (varlist); + + elt = XCAR (varlist); if (SYMBOLP (elt)) - specbind (elt, Qnil); + { + var = elt; + val = Qnil; + } else if (! NILP (Fcdr (Fcdr (elt)))) signal_error ("`let' bindings can have only one value-form", elt); else { + var = Fcar (elt); val = Feval (Fcar (Fcdr (elt))); - specbind (Fcar (elt), val); } - varlist = Fcdr (varlist); + + if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + /* Lexically bind VAR by adding it to the interpreter's binding + alist. */ + { + lexenv = Fcons (Fcons (var, val), lexenv); + specbind (Qinternal_interpreter_environment, lexenv); + } + else + specbind (var, val); + + varlist = XCDR (varlist); } + UNGCPRO; + val = Fprogn (Fcdr (args)); + return unbind_to (count, val); } @@ -1043,7 +1104,7 @@ usage: (let VARLIST BODY...) */) (args) Lisp_Object args; { - Lisp_Object *temps, tem; + Lisp_Object *temps, tem, lexenv; register Lisp_Object elt, varlist; int count = SPECPDL_INDEX (); register int argnum; @@ -1074,18 +1135,31 @@ usage: (let VARLIST BODY...) */) } UNGCPRO; + lexenv = Vinternal_interpreter_environment; + varlist = Fcar (args); for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) { + Lisp_Object var; + elt = XCAR (varlist); + var = SYMBOLP (elt) ? elt : Fcar (elt); tem = temps[argnum++]; - if (SYMBOLP (elt)) - specbind (elt, tem); + + if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + /* Lexically bind VAR by adding it to the lexenv alist. */ + lexenv = Fcons (Fcons (var, tem), lexenv); else - specbind (Fcar (elt), tem); + /* Dynamically bind VAR. */ + specbind (var, tem); } + if (!EQ (lexenv, Vinternal_interpreter_environment)) + /* Instantiate a new lexical environment. */ + specbind (Qinternal_interpreter_environment, lexenv); + elt = Fprogn (Fcdr (args)); + return unbind_to (count, elt); } @@ -2292,7 +2366,28 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, abort (); if (SYMBOLP (form)) - return Fsymbol_value (form); + { + /* If there's an active lexical environment, and the variable + isn't declared special, look up its binding in the lexical + environment. */ + if (!NILP (Vinternal_interpreter_environment) + && !XSYMBOL (form)->declared_special) + { + Lisp_Object lex_binding + = Fassq (form, Vinternal_interpreter_environment); + + /* If we found a lexical binding for FORM, return the value. + Otherwise, we just drop through and look for a dynamic + binding -- the variable isn't declared special, but there's + not much else we can do, and Fsymbol_value will take care + of signaling an error if there is no binding at all. */ + if (CONSP (lex_binding)) + return XCDR (lex_binding); + } + + return Fsymbol_value (form); + } + if (!CONSP (form)) return form; @@ -2452,8 +2547,8 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, abort (); } } - if (COMPILEDP (fun)) - val = apply_lambda (fun, original_args, 1); + if (FUNVECP (fun)) + val = apply_lambda (fun, original_args, 1, Qnil); else { if (EQ (fun, Qunbound)) @@ -2471,7 +2566,18 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (EQ (funcar, Qmacro)) val = Feval (apply1 (Fcdr (fun), original_args)); else if (EQ (funcar, Qlambda)) - val = apply_lambda (fun, original_args, 1); + val = apply_lambda (fun, original_args, 1, + /* Only pass down the current lexical environment + if FUN is lexically embedded in FORM. */ + (CONSP (original_fun) + ? Vinternal_interpreter_environment + : Qnil)); + else if (EQ (funcar, Qclosure) + && CONSP (XCDR (fun)) + && CONSP (XCDR (XCDR (fun))) + && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) + val = apply_lambda (XCDR (XCDR (fun)), original_args, 1, + XCAR (XCDR (fun))); else xsignal1 (Qinvalid_function, original_fun); } @@ -2981,6 +3087,40 @@ call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7) /* The caller should GCPRO all the elements of ARGS. */ +DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, + doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */) + (object) + Lisp_Object object; +{ + if (SYMBOLP (object) && !NILP (Ffboundp (object))) + { + object = Findirect_function (object, Qnil); + + if (CONSP (object) && EQ (XCAR (object), Qautoload)) + { + /* Autoloaded symbols are functions, except if they load + macros or keymaps. */ + int i; + for (i = 0; i < 4 && CONSP (object); i++) + object = XCDR (object); + + return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt; + } + } + + if (SUBRP (object)) + return (XSUBR (object)->max_args != Qunevalled) ? Qt : Qnil; + else if (FUNVECP (object)) + return Qt; + else if (CONSP (object)) + { + Lisp_Object car = XCAR (object); + return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil; + } + else + return Qnil; +} + DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, doc: /* Call first argument as a function, passing remaining arguments to it. Return the value that function returns. @@ -3115,8 +3255,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) abort (); } } - if (COMPILEDP (fun)) - val = funcall_lambda (fun, numargs, args + 1); + + if (FUNVECP (fun)) + val = funcall_lambda (fun, numargs, args + 1, Qnil); else { if (EQ (fun, Qunbound)) @@ -3127,7 +3268,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qlambda)) - val = funcall_lambda (fun, numargs, args + 1); + val = funcall_lambda (fun, numargs, args + 1, Qnil); + else if (EQ (funcar, Qclosure) + && CONSP (XCDR (fun)) + && CONSP (XCDR (XCDR (fun))) + && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) + val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1, + XCAR (XCDR (fun))); else if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -3147,9 +3294,10 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } Lisp_Object -apply_lambda (fun, args, eval_flag) +apply_lambda (fun, args, eval_flag, lexenv) Lisp_Object fun, args; int eval_flag; + Lisp_Object lexenv; { Lisp_Object args_left; Lisp_Object numargs; @@ -3181,7 +3329,7 @@ apply_lambda (fun, args, eval_flag) backtrace_list->nargs = i; } backtrace_list->evalargs = 0; - tem = funcall_lambda (fun, XINT (numargs), arg_vector); + tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); /* Do the debug-on-exit now, while arg_vector still exists. */ if (backtrace_list->debug_on_exit) @@ -3191,20 +3339,100 @@ apply_lambda (fun, args, eval_flag) return tem; } + +/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of + length NARGS). */ + +static Lisp_Object +funcall_funvec (fun, nargs, args) + Lisp_Object fun; + int nargs; + Lisp_Object *args; +{ + int size = FUNVEC_SIZE (fun); + Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil); + + if (EQ (tag, Qcurry)) + { + /* A curried function is a way to attach arguments to a another + function. The first element of the vector is the identifier + `curry', the second is the wrapped function, and remaining + elements are the attached arguments. */ + int num_curried_args = size - 2; + /* Offset of the curried and user args in the final arglist. Curried + args are first in the new arg vector, after the function. User + args follow. */ + int curried_args_offs = 1; + int user_args_offs = curried_args_offs + num_curried_args; + /* The curried function and arguments. */ + Lisp_Object *curry_params = XVECTOR (fun)->contents + 1; + /* The arguments in the curry vector. */ + Lisp_Object *curried_args = curry_params + 1; + /* The number of arguments with which we'll call funcall, and the + arguments themselves. */ + int num_funcall_args = 1 + num_curried_args + nargs; + Lisp_Object *funcall_args + = (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object)); + + /* First comes the real function. */ + funcall_args[0] = curry_params[0]; + + /* Then the arguments in the appropriate order. */ + bcopy (curried_args, funcall_args + curried_args_offs, + num_curried_args * sizeof (Lisp_Object)); + bcopy (args, funcall_args + user_args_offs, + nargs * sizeof (Lisp_Object)); + + return Ffuncall (num_funcall_args, funcall_args); + } + else + xsignal1 (Qinvalid_function, fun); +} + + /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR and return the result of evaluation. FUN must be either a lambda-expression or a compiled-code object. */ static Lisp_Object -funcall_lambda (fun, nargs, arg_vector) +funcall_lambda (fun, nargs, arg_vector, lexenv) Lisp_Object fun; int nargs; register Lisp_Object *arg_vector; + Lisp_Object lexenv; { Lisp_Object val, syms_left, next; int count = SPECPDL_INDEX (); int i, optional, rest; + if (COMPILEDP (fun) + && FUNVEC_SIZE (fun) > COMPILED_PUSH_ARGS + && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS])) + /* A byte-code object with a non-nil `push args' slot means we + shouldn't bind any arguments, instead just call the byte-code + interpreter directly; it will push arguments as necessary. + + Byte-code objects with either a non-existant, or a nil value for + the `push args' slot (the default), have dynamically-bound + arguments, and use the argument-binding code below instead (as do + all interpreted functions, even lexically bound ones). */ + { + /* If we have not actually read the bytecode string + and constants vector yet, fetch them from the file. */ + if (CONSP (AREF (fun, COMPILED_BYTECODE))) + Ffetch_bytecode (fun); + return exec_byte_code (AREF (fun, COMPILED_BYTECODE), + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + AREF (fun, COMPILED_ARGLIST), + nargs, arg_vector); + } + + if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun)) + /* Byte-compiled functions are handled directly below, but we + call other funvec types via funcall_funvec. */ + return funcall_funvec (fun, nargs, arg_vector); + if (CONSP (fun)) { syms_left = XCDR (fun); @@ -3236,12 +3464,27 @@ funcall_lambda (fun, nargs, arg_vector) specbind (next, Flist (nargs - i, &arg_vector[i])); i = nargs; } - else if (i < nargs) - specbind (next, arg_vector[i++]); - else if (!optional) - xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else - specbind (next, Qnil); + { + Lisp_Object val; + + /* Get the argument's actual value. */ + if (i < nargs) + val = arg_vector[i++]; + else if (!optional) + xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + else + val = Qnil; + + /* Bind the argument. */ + if (!NILP (lexenv) + && SYMBOLP (next) && !XSYMBOL (next)->declared_special) + /* Lexically bind NEXT by adding it to the lexenv alist. */ + lexenv = Fcons (Fcons (next, val), lexenv); + else + /* Dynamically bind NEXT. */ + specbind (next, val); + } } if (!NILP (syms_left)) @@ -3249,6 +3492,10 @@ funcall_lambda (fun, nargs, arg_vector) else if (i < nargs) xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); + if (!EQ (lexenv, Vinternal_interpreter_environment)) + /* Instantiate a new lexical environment. */ + specbind (Qinternal_interpreter_environment, lexenv); + if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); else @@ -3257,9 +3504,10 @@ funcall_lambda (fun, nargs, arg_vector) and constants vector yet, fetch them from the file. */ if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); - val = Fbyte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH)); + val = exec_byte_code (AREF (fun, COMPILED_BYTECODE), + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + Qnil, 0, 0); } return unbind_to (count, val); @@ -3502,7 +3750,42 @@ unbind_to (count, value) UNGCPRO; return value; } + + +DEFUN ("specialp", Fspecialp, Sspecialp, 1, 1, 0, + doc: /* Return non-nil if SYMBOL's global binding has been declared special. +A special variable is one that will be bound dynamically, even in a +context where binding is lexical by default. */) + (symbol) + Lisp_Object symbol; +{ + CHECK_SYMBOL (symbol); + return XSYMBOL (symbol)->declared_special ? Qt : Qnil; +} + + + +DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0, + doc: /* Return FUN curried with ARGS. +The result is a function-like object that will append any arguments it +is called with to ARGS, and call FUN with the resulting list of arguments. + +For instance: + (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2) +and: + (mapcar (curry 'concat "The ") '("a" "b" "c")) + => ("The a" "The b" "The c") + +usage: (curry FUN &rest ARGS) */) + (nargs, args) + register int nargs; + Lisp_Object *args; +{ + return make_funvec (Qcurry, 0, nargs, args); +} + + DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. */) @@ -3713,6 +3996,15 @@ before making `inhibit-quit' nil. */); Qand_optional = intern_c_string ("&optional"); staticpro (&Qand_optional); + Qclosure = intern_c_string ("closure"); + staticpro (&Qclosure); + + Qcurry = intern_c_string ("curry"); + staticpro (&Qcurry); + + Qunevalled = intern_c_string ("unevalled"); + staticpro (&Qunevalled); + Qdebug = intern_c_string ("debug"); staticpro (&Qdebug); @@ -3788,6 +4080,17 @@ DECL is a list `(declare ...)' containing the declarations. The value the function returns is not used. */); Vmacro_declaration_function = Qnil; + Qinternal_interpreter_environment + = intern_c_string ("internal-interpreter-environment"); + staticpro (&Qinternal_interpreter_environment); + DEFVAR_LISP ("internal-interpreter-environment", + &Vinternal_interpreter_environment, + doc: /* If non-nil, the current lexical environment of the lisp interpreter. +When lexical binding is not being used, this variable is nil. +A value of `(t)' indicates an empty environment, otherwise it is an +alist of active lexical bindings. */); + Vinternal_interpreter_environment = Qnil; + Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); @@ -3833,9 +4136,13 @@ The value the function returns is not used. */); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Sfetch_bytecode); + defsubr (&Scurry); defsubr (&Sbacktrace_debug); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); + defsubr (&Scurry); + defsubr (&Sspecialp); + defsubr (&Sfunctionp); } /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb diff --git a/src/fns.c b/src/fns.c index 3f984905d1e..9569c214268 100644 --- a/src/fns.c +++ b/src/fns.c @@ -149,8 +149,8 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, MAX_CHAR); else if (BOOL_VECTOR_P (sequence)) XSETFASTINT (val, XBOOL_VECTOR (sequence)->size); - else if (COMPILEDP (sequence)) - XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); + else if (FUNVECP (sequence)) + XSETFASTINT (val, FUNVEC_SIZE (sequence)); else if (CONSP (sequence)) { i = 0; @@ -535,7 +535,7 @@ concat (nargs, args, target_type, last_special) { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) - || COMPILEDP (this) || BOOL_VECTOR_P (this))) + || FUNVECP (this) || BOOL_VECTOR_P (this))) wrong_type_argument (Qsequencep, this); } @@ -559,7 +559,7 @@ concat (nargs, args, target_type, last_special) Lisp_Object ch; int this_len_byte; - if (VECTORP (this)) + if (VECTORP (this) || FUNVECP (this)) for (i = 0; i < len; i++) { ch = AREF (this, i); @@ -1383,7 +1383,9 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, return Fcar (Fnthcdr (n, sequence)); /* Faref signals a "not array" error, so check here. */ - CHECK_ARRAY (sequence, Qsequencep); + if (! FUNVECP (sequence)) + CHECK_ARRAY (sequence, Qsequencep); + return Faref (sequence, n); } @@ -2199,13 +2201,14 @@ internal_equal (o1, o2, depth, props) if (WINDOW_CONFIGURATIONP (o1)) return compare_window_configurations (o1, o2, 0); - /* Aside from them, only true vectors, char-tables, compiled - functions, and fonts (font-spec, font-entity, font-ojbect) - are sensible to compare, so eliminate the others now. */ + /* Aside from them, only true vectors, char-tables, function vectors, + and fonts (font-spec, font-entity, font-ojbect) are sensible to + compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & (PVEC_COMPILED - | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) + if (!(size & (PVEC_FUNVEC + | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE + | PVEC_FONT))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -2416,7 +2419,7 @@ mapcar1 (leni, vals, fn, seq) 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ - if (VECTORP (seq)) + if (VECTORP (seq) || FUNVECP (seq)) { for (i = 0; i < leni; i++) { diff --git a/src/image.c b/src/image.c index b9620e10948..67c228cbc7f 100644 --- a/src/image.c +++ b/src/image.c @@ -885,7 +885,7 @@ parse_image_spec (spec, keywords, nkeywords, type) case IMAGE_FUNCTION_VALUE: value = indirect_function (value); if (SUBRP (value) - || COMPILEDP (value) + || FUNVECP (value) || (CONSP (value) && EQ (XCAR (value), Qlambda))) break; return 0; diff --git a/src/keyboard.c b/src/keyboard.c index 63372d600e3..18d75f9b01c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10390,7 +10390,7 @@ a special event, so ignore the prefix argument and don't clear it. */) return Fexecute_kbd_macro (final, prefixarg, Qnil); } - if (CONSP (final) || SUBRP (final) || COMPILEDP (final)) + if (CONSP (final) || SUBRP (final) || FUNVECP (final)) /* Don't call Fcall_interactively directly because we want to make sure the backtrace has an entry for `call-interactively'. For the same reason, pass `cmd' rather than `final'. */ diff --git a/src/lisp.h b/src/lisp.h index 1941a2471a4..c7e8ea0fb8b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -344,7 +344,7 @@ enum pvec_type PVEC_NORMAL_VECTOR = 0, PVEC_PROCESS = 0x200, PVEC_FRAME = 0x400, - PVEC_COMPILED = 0x800, + PVEC_FUNVEC = 0x800, PVEC_WINDOW = 0x1000, PVEC_WINDOW_CONFIGURATION = 0x2000, PVEC_SUBR = 0x4000, @@ -623,7 +623,7 @@ extern size_t pure_size; #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) -#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) +#define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC)) #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) @@ -639,6 +639,9 @@ extern size_t pure_size; eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \ AREF ((ARRAY), (IDX)) = (VAL)) +/* Return the size of the psuedo-vector object FUNVEC. */ +#define FUNVEC_SIZE(funvec) (ASIZE (funvec) & PSEUDOVECTOR_SIZE_MASK) + /* Convenience macros for dealing with Lisp strings. */ #define SDATA(string) (XSTRING (string)->data + 0) @@ -1020,6 +1023,10 @@ struct Lisp_Symbol /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ unsigned interned : 2; + + /* Non-zero means that this variable has been explicitly declared + special (with `defvar' etc), and shouldn't be lexically bound. */ + unsigned declared_special : 1; /* The symbol's name, as a Lisp string. @@ -1475,7 +1482,7 @@ struct Lisp_Float typedef unsigned char UCHAR; #endif -/* Meanings of slots in a Lisp_Compiled: */ +/* Meanings of slots in a byte-compiled function vector: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 @@ -1483,6 +1490,25 @@ typedef unsigned char UCHAR; #define COMPILED_STACK_DEPTH 3 #define COMPILED_DOC_STRING 4 #define COMPILED_INTERACTIVE 5 +#define COMPILED_PUSH_ARGS 6 + +/* Return non-zero if TAG, the first element from a funvec object, refers + to a byte-code object. Byte-code objects are distinguished from other + `funvec' objects by having a (possibly empty) list as their first + element -- other funvec types use a non-nil symbol there. */ +#define FUNVEC_COMPILED_TAG_P(tag) \ + (NILP (tag) || CONSP (tag)) + +/* Return non-zero if FUNVEC, which should be a `funvec' object, is a + byte-compiled function. Byte-compiled function are funvecs with the + arglist as the first element (other funvec types will have a symbol + identifying the type as the first object). */ +#define FUNVEC_COMPILED_P(funvec) \ + (FUNVEC_SIZE (funvec) > 0 && FUNVEC_COMPILED_TAG_P (AREF (funvec, 0))) + +/* Return non-zero if OBJ is byte-compile function. */ +#define COMPILEDP(obj) \ + (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE @@ -1604,7 +1630,7 @@ typedef struct { #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) +#define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) @@ -1797,7 +1823,7 @@ typedef struct { #define FUNCTIONP(OBJ) \ ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ - || COMPILEDP (OBJ) \ + || FUNVECP (OBJ) \ || SUBRP (OBJ)) /* defsubr (Sname); @@ -2697,6 +2723,7 @@ EXFUN (Fmake_list, 2); extern Lisp_Object allocate_misc P_ ((void)); EXFUN (Fmake_vector, 2); EXFUN (Fvector, MANY); +EXFUN (Ffunvec, MANY); EXFUN (Fmake_symbol, 1); EXFUN (Fmake_marker, 0); EXFUN (Fmake_string, 2); @@ -2715,6 +2742,7 @@ extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object make_pure_vector P_ ((EMACS_INT)); EXFUN (Fgarbage_collect, 0); +extern Lisp_Object make_funvec P_ ((Lisp_Object, int, int, Lisp_Object *)); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_bool_vector, 2); extern Lisp_Object Qchar_table_extra_slots; @@ -2894,7 +2922,7 @@ extern Lisp_Object call5 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object extern Lisp_Object call6 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); extern Lisp_Object call7 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); EXFUN (Fdo_auto_save, 2); -extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int)); +extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int, Lisp_Object)); extern Lisp_Object internal_catch P_ ((Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object)); extern Lisp_Object internal_lisp_condition_case P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); extern Lisp_Object internal_condition_case P_ ((Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object))); @@ -3312,11 +3340,13 @@ extern int read_bytecode_char P_ ((int)); /* Defined in bytecode.c */ extern Lisp_Object Qbytecode; -EXFUN (Fbyte_code, 3); +EXFUN (Fbyte_code, MANY); extern void syms_of_bytecode P_ ((void)); extern struct byte_stack *byte_stack_list; extern void mark_byte_stack P_ ((void)); extern void unmark_byte_stack P_ ((void)); +extern Lisp_Object exec_byte_code P_ ((Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, int, Lisp_Object *)); /* Defined in macros.c */ extern Lisp_Object Qexecute_kbd_macro; diff --git a/src/lread.c b/src/lread.c index 3a77a62b27f..53f26faea36 100644 --- a/src/lread.c +++ b/src/lread.c @@ -83,6 +83,7 @@ Lisp_Object Qascii_character, Qload, Qload_file_name; Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; Lisp_Object Qinhibit_file_name_operation; Lisp_Object Qeval_buffer_list, Veval_buffer_list; +Lisp_Object Qlexical_binding; Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ /* Used instead of Qget_file_char while loading *.elc files compiled @@ -93,6 +94,7 @@ static Lisp_Object Qload_force_doc_strings; extern Lisp_Object Qevent_symbol_element_mask; extern Lisp_Object Qfile_exists_p; +extern Lisp_Object Qinternal_interpreter_environment; /* non-zero if inside `load' */ int load_in_progress; @@ -157,6 +159,9 @@ Lisp_Object Vread_with_symbol_positions; /* List of (SYMBOL . POSITION) accumulated so far. */ Lisp_Object Vread_symbol_positions_list; +/* If non-nil `readevalloop' evaluates code in a lexical environment. */ +Lisp_Object Vlexical_binding; + /* List of descriptors now open for Fload. */ static Lisp_Object load_descriptor_list; @@ -864,6 +869,118 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, + +/* Return true if the lisp code read using READCHARFUN defines a non-nil + `lexical-binding' file variable. After returning, the stream is + positioned following the first line, if it is a comment, otherwise + nothing is read. */ + +static int +lisp_file_lexically_bound_p (readcharfun) + Lisp_Object readcharfun; +{ + int ch = READCHAR; + if (ch != ';') + /* The first line isn't a comment, just give up. */ + { + UNREAD (ch); + return 0; + } + else + /* Look for an appropriate file-variable in the first line. */ + { + int rv = 0; + enum { + NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX, + } beg_end_state = NOMINAL; + int in_file_vars = 0; + +#define UPDATE_BEG_END_STATE(ch) \ + if (beg_end_state == NOMINAL) \ + beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ + else if (beg_end_state == AFTER_FIRST_DASH) \ + beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ + else if (beg_end_state == AFTER_ASTERIX) \ + { \ + if (ch == '-') \ + in_file_vars = !in_file_vars; \ + beg_end_state = NOMINAL; \ + } + + /* Skip until we get to the file vars, if any. */ + do + { + ch = READCHAR; + UPDATE_BEG_END_STATE (ch); + } + while (!in_file_vars && ch != '\n' && ch != EOF); + + while (in_file_vars) + { + char var[100], *var_end, val[100], *val_end; + + ch = READCHAR; + + /* Read a variable name. */ + while (ch == ' ' || ch == '\t') + ch = READCHAR; + + var_end = var; + while (ch != ':' && ch != '\n' && ch != EOF) + { + if (var_end < var + sizeof var - 1) + *var_end++ = ch; + UPDATE_BEG_END_STATE (ch); + ch = READCHAR; + } + + while (var_end > var + && (var_end[-1] == ' ' || var_end[-1] == '\t')) + var_end--; + *var_end = '\0'; + + if (ch == ':') + { + /* Read a variable value. */ + ch = READCHAR; + + while (ch == ' ' || ch == '\t') + ch = READCHAR; + + val_end = val; + while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars) + { + if (val_end < val + sizeof val - 1) + *val_end++ = ch; + UPDATE_BEG_END_STATE (ch); + ch = READCHAR; + } + if (! in_file_vars) + /* The value was terminated by an end-marker, which + remove. */ + val_end -= 3; + while (val_end > val + && (val_end[-1] == ' ' || val_end[-1] == '\t')) + val_end--; + *val_end = '\0'; + + if (strcmp (var, "lexical-binding") == 0) + /* This is it... */ + { + rv = (strcmp (val, "nil") != 0); + break; + } + } + } + + while (ch != '\n' && ch != EOF) + ch = READCHAR; + + return rv; + } +} + + /* Value is a version number of byte compiled code if the file associated with file descriptor FD is a compiled Lisp file that's safe to load. Only files compiled with Emacs are safe to load. @@ -1129,6 +1246,12 @@ Return t if the file exists and loads successfully. */) Vloads_in_progress = Fcons (found, Vloads_in_progress); } + /* All loads are by default dynamic, unless the file itself specifies + otherwise using a file-variable in the first line. This is bound here + so that it takes effect whether or not we use + Vload_source_file_function. */ + specbind (Qlexical_binding, Qnil); + /* Get the name for load-history. */ hist_file_name = (! NILP (Vpurify_flag) ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), @@ -1253,7 +1376,13 @@ Return t if the file exists and loads successfully. */) specbind (Qinhibit_file_name_operation, Qnil); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); + specbind (Qload_in_progress, Qt); + + instream = stream; + if (lisp_file_lexically_bound_p (Qget_file_char)) + Fset (Qlexical_binding, Qt); + if (! version || version >= 22) readevalloop (Qget_file_char, stream, hist_file_name, Feval, 0, Qnil, Qnil, Qnil, Qnil); @@ -1652,6 +1781,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; int continue_reading_p; + Lisp_Object lex_bound; /* Nonzero if reading an entire buffer. */ int whole_buffer = 0; /* 1 on the first time around. */ @@ -1677,6 +1807,15 @@ readevalloop (readcharfun, stream, sourcename, evalfun, record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); load_convert_to_unibyte = !NILP (unibyte); + /* If lexical binding is active (either because it was specified in + the file's header, or via a buffer-local variable), create an empty + lexical environment, otherwise, turn off lexical binding. */ + lex_bound = find_symbol_value (Qlexical_binding); + if (NILP (lex_bound) || EQ (lex_bound, Qunbound)) + specbind (Qinternal_interpreter_environment, Qnil); + else + specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil)); + GCPRO4 (sourcename, readfun, start, end); /* Try to ensure sourcename is a truename, except whilst preloading. */ @@ -1837,8 +1976,11 @@ This function preserves the position of point. */) specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); + specbind (Qlexical_binding, Qnil); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); + if (lisp_file_lexically_bound_p (buf)) + Fset (Qlexical_binding, Qt); readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -2481,14 +2623,8 @@ read1 (readcharfun, pch, first_in_list) invalid_syntax ("#&...", 5); } if (c == '[') - { - /* Accept compiled functions at read-time so that we don't have to - build them using function calls. */ - Lisp_Object tmp; - tmp = read_vector (readcharfun, 1); - return Fmake_byte_code (XVECTOR (tmp)->size, - XVECTOR (tmp)->contents); - } + /* `function vector' objects, including byte-compiled functions. */ + return read_vector (readcharfun, 1); if (c == '(') { Lisp_Object tmp; @@ -3300,9 +3436,9 @@ isfloat_string (cp, ignore_trailing) static Lisp_Object -read_vector (readcharfun, bytecodeflag) +read_vector (readcharfun, read_funvec) Lisp_Object readcharfun; - int bytecodeflag; + int read_funvec; { register int i; register int size; @@ -3310,6 +3446,11 @@ read_vector (readcharfun, bytecodeflag) register Lisp_Object tem, item, vector; register struct Lisp_Cons *otem; Lisp_Object len; + /* If we're reading a funvec object we start out assuming it's also a + byte-code object (a subset of funvecs), so we can do any special + processing needed. If it's just an ordinary funvec object, we'll + realize that as soon as we've read the first element. */ + int read_bytecode = read_funvec; tem = read_list (1, readcharfun); len = Flength (tem); @@ -3320,11 +3461,19 @@ read_vector (readcharfun, bytecodeflag) for (i = 0; i < size; i++) { item = Fcar (tem); + + /* If READ_BYTECODE is set, check whether this is really a byte-code + object, or just an ordinary `funvec' object -- non-byte-code + funvec objects use the same reader syntax. We can tell from the + first element which one it is. */ + if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item)) + read_bytecode = 0; /* Nope. */ + /* If `load-force-doc-strings' is t when reading a lazily-loaded bytecode object, the docstring containing the bytecode and constants values must be treated as unibyte and passed to Fread, to get the actual bytecode string and constants vector. */ - if (bytecodeflag && load_force_doc_strings) + if (read_bytecode && load_force_doc_strings) { if (i == COMPILED_BYTECODE) { @@ -3377,6 +3526,14 @@ read_vector (readcharfun, bytecodeflag) tem = Fcdr (tem); free_cons (otem); } + + if (read_bytecode && size >= 4) + /* Convert this vector to a bytecode object. */ + vector = Fmake_byte_code (size, XVECTOR (vector)->contents); + else if (read_funvec && size >= 1) + /* Convert this vector to an ordinary funvec object. */ + XSETFUNVEC (vector, XVECTOR (vector)); + return vector; } @@ -3979,6 +4136,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd, sym = intern_c_string (namestring); i_fwd->type = Lisp_Fwd_Int; i_fwd->intvar = address; + XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); } @@ -3993,6 +4151,7 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd, sym = intern_c_string (namestring); b_fwd->type = Lisp_Fwd_Bool; b_fwd->boolvar = address; + XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); @@ -4011,6 +4170,7 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd, sym = intern_c_string (namestring); o_fwd->type = Lisp_Fwd_Obj; o_fwd->objvar = address; + XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); } @@ -4023,6 +4183,7 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd, staticpro (address); } + /* Similar but define a variable whose value is the Lisp Object stored at a particular offset in the current kboard object. */ @@ -4034,6 +4195,7 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd, sym = intern_c_string (namestring); ko_fwd->type = Lisp_Fwd_Kboard_Obj; ko_fwd->offset = offset; + XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); } @@ -4463,6 +4625,16 @@ to load. See also `load-dangerous-libraries'. */); Vbytecomp_version_regexp = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + Qlexical_binding = intern ("lexical-binding"); + staticpro (&Qlexical_binding); + DEFVAR_LISP ("lexical-binding", &Vlexical_binding, + doc: /* If non-nil, use lexical binding when evaluating code. +This only applies to code evaluated by `eval-buffer' and `eval-region'. +This variable is automatically set from the file variables of an interpreted + lisp file read using `load'. +This variable automatically becomes buffer-local when set. */); + Fmake_variable_buffer_local (Qlexical_binding); + DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list, doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); Veval_buffer_list = Qnil; diff --git a/src/print.c b/src/print.c index 6d403e00fe0..fb298233666 100644 --- a/src/print.c +++ b/src/print.c @@ -1340,7 +1340,7 @@ print_preprocess (obj) loop: if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -1543,7 +1543,7 @@ print_object (obj, printcharfun, escapeflag) /* Detect circularities and truncate them. */ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -2175,7 +2175,7 @@ print_object (obj, printcharfun, escapeflag) else { EMACS_INT size = XVECTOR (obj)->size; - if (COMPILEDP (obj)) + if (FUNVECP (obj)) { PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; -- cgit v1.2.1 From 3c3ddb9833996729545bb4909bea359e5dbaa02e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 14 Jun 2010 22:51:25 -0400 Subject: * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Don't macroexpand before evaluating in eval-and-compile, in case `body's macro expansion uses macros and functions defined in itself. * src/bytecode.c (exec_byte_code): * src/eval.c (Ffunctionp): Fix up int/Lisp_Object confusions. --- src/ChangeLog | 5 +++++ src/bytecode.c | 2 +- src/eval.c | 7 ++----- 3 files changed, 8 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 3e6c8f24398..017b3eb2553 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2010-06-15 Stefan Monnier + + * bytecode.c (exec_byte_code): + * eval.c (Ffunctionp): Fix up int/Lisp_Object confusions. + 2010-06-12 Eli Zaretskii * makefile.w32-in ($(BLD)/bidi.$(O)): Depend on biditype.h and diff --git a/src/bytecode.c b/src/bytecode.c index fec855c0b83..192d397c45f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1742,7 +1742,7 @@ exec_byte_code (bytestr, vector, maxdepth, args_template, nargs, args) if (! VECTORP (vec)) wrong_type_argument (Qvectorp, vec); else if (index < 0 || index >= XVECTOR (vec)->size) - args_out_of_range (vec, index); + args_out_of_range (vec, make_number (index)); if (op == Bvec_ref) PUSH (XVECTOR (vec)->contents[index]); diff --git a/src/eval.c b/src/eval.c index 875b4498a61..71a0b111849 100644 --- a/src/eval.c +++ b/src/eval.c @@ -62,7 +62,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; -Lisp_Object Qcurry, Qunevalled; +Lisp_Object Qcurry; Lisp_Object Qinternal_interpreter_environment, Qclosure; Lisp_Object Qdebug; @@ -3109,7 +3109,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, } if (SUBRP (object)) - return (XSUBR (object)->max_args != Qunevalled) ? Qt : Qnil; + return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil; else if (FUNVECP (object)) return Qt; else if (CONSP (object)) @@ -4002,9 +4002,6 @@ before making `inhibit-quit' nil. */); Qcurry = intern_c_string ("curry"); staticpro (&Qcurry); - Qunevalled = intern_c_string ("unevalled"); - staticpro (&Qunevalled); - Qdebug = intern_c_string ("debug"); staticpro (&Qdebug); -- cgit v1.2.1 From 4a330052b4815cf833071aae5cb312f6f0f63613 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Jun 2010 09:11:47 -0400 Subject: * src/eval.c (Fspecial_variable_p): Rename from `specialp'. * lisp/emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo): specialp -> special-variable-p. --- src/ChangeLog | 4 ++++ src/eval.c | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 017b3eb2553..e70aefd75b5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-06-18 Stefan Monnier + + * eval.c (Fspecial_variable_p): Rename from `specialp'. + 2010-06-15 Stefan Monnier * bytecode.c (exec_byte_code): diff --git a/src/eval.c b/src/eval.c index 71a0b111849..a6290618753 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3753,7 +3753,7 @@ unbind_to (count, value) -DEFUN ("specialp", Fspecialp, Sspecialp, 1, 1, 0, +DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a context where binding is lexical by default. */) @@ -4138,7 +4138,7 @@ alist of active lexical bindings. */); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); defsubr (&Scurry); - defsubr (&Sspecialp); + defsubr (&Sspecial_variable_p); defsubr (&Sfunctionp); } -- cgit v1.2.1 From 0bfdb86f425a88fe43ebc88851c6f9a6418e1862 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Fri, 23 Jul 2010 18:48:41 +0200 Subject: * eval.c (funcall_funvec): Replace bcopy by memcpy. --- src/ChangeLog | 4 ++++ src/eval.c | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 6329382df95..e1c0e6e5e9a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-07-23 Andreas Schwab + + * eval.c (funcall_funvec): Replace bcopy by memcpy. + 2010-06-18 Stefan Monnier * eval.c (Fspecial_variable_p): Rename from `specialp'. diff --git a/src/eval.c b/src/eval.c index ec031f391c8..940e52a4d0a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3292,10 +3292,10 @@ funcall_funvec (fun, nargs, args) funcall_args[0] = curry_params[0]; /* Then the arguments in the appropriate order. */ - bcopy (curried_args, funcall_args + curried_args_offs, - num_curried_args * sizeof (Lisp_Object)); - bcopy (args, funcall_args + user_args_offs, - nargs * sizeof (Lisp_Object)); + memcpy (funcall_args + curried_args_offs, curried_args, + num_curried_args * sizeof (Lisp_Object)); + memcpy (funcall_args + user_args_offs, args, + nargs * sizeof (Lisp_Object)); return Ffuncall (num_funcall_args, funcall_args); } -- cgit v1.2.1 From f07a954eeb0930029104402e706165bf89853576 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 12 Dec 2010 23:04:15 -0500 Subject: Make the effect of (defvar foo) local. * src/eval.c (apply_lambda): Make static. Remove eval_flag arg. (Fsetq): Don't check declared_special. (Fdefun, Fdefmacro): Use Ffunction. (Fdefvar): Don't set declared_special for (defvar foo). (FletX): Check locally-special vars. Only do specbind once. (Flet): Check locally-special vars. (Feval): Don't check declared_special. (funcall_lambda): Check locally-special vars. * src/lisp.h (apply_lambda): Remove extern declaration. * src/lread.c (readevalloop): CSE. * lisp/subr.el (with-lexical-binding): Remove. --- src/ChangeLog | 14 +++++++ src/eval.c | 116 +++++++++++++++++++++++++++++++++------------------------- src/lisp.h | 1 - src/lread.c | 7 ++-- 4 files changed, 83 insertions(+), 55 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e1c0e6e5e9a..6abdf583b00 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,17 @@ +2010-12-13 Stefan Monnier + + Make the effect of (defvar foo) local. + * eval.c (apply_lambda): Make static. Remove eval_flag arg. + (Fsetq): Don't check declared_special. + (Fdefun, Fdefmacro): Use Ffunction. + (Fdefvar): Don't set declared_special for (defvar foo). + (FletX): Check locally-special vars. Only do specbind once. + (Flet): Check locally-special vars. + (Feval): Don't check declared_special. + (funcall_lambda): Check locally-special vars. + * lisp.h (apply_lambda): Remove extern declaration. + * lread.c (readevalloop): CSE. + 2010-07-23 Andreas Schwab * eval.c (funcall_funvec): Replace bcopy by memcpy. diff --git a/src/eval.c b/src/eval.c index 574c4ebf361..63ea95513b3 100644 --- a/src/eval.c +++ b/src/eval.c @@ -81,9 +81,12 @@ Lisp_Object Vrun_hooks; Lisp_Object Vautoload_queue; /* When lexical binding is being used, this is non-nil, and contains an - alist of lexically-bound variable, or t, indicating an empty + alist of lexically-bound variable, or (t), indicating an empty environment. The lisp name of this variable is - `internal-interpreter-lexical-environment'. */ + `internal-interpreter-environment'. Every element of this list + can be either a cons (VAR . VAL) specifying a lexical binding, + or a single symbol VAR indicating that this variable should use + dynamic scoping. */ Lisp_Object Vinternal_interpreter_environment; @@ -175,6 +178,8 @@ int handling_signal; Lisp_Object Vmacro_declaration_function; +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, + Lisp_Object lexenv) static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *, Lisp_Object); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; @@ -505,10 +510,12 @@ usage: (setq [SYM VAL]...) */) val = Feval (Fcar (Fcdr (args_left))); sym = Fcar (args_left); - if (!NILP (Vinternal_interpreter_environment) + /* Like for Feval, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ && SYMBOLP (sym) - && !XSYMBOL (sym)->declared_special - && !NILP (lex_binding = Fassq (sym, Vinternal_interpreter_environment))) + && !NILP (lex_binding + = Fassq (sym, Vinternal_interpreter_environment))) XSETCDR (lex_binding, val); /* SYM is lexically bound. */ else Fset (sym, val); /* SYM is dynamically bound. */ @@ -667,8 +674,8 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) fn_name = Fcar (args); CHECK_SYMBOL (fn_name); defn = Fcons (Qlambda, Fcdr (args)); - if (! NILP (Vinternal_interpreter_environment)) - defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn)); + if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ + defn = Ffunction (Fcons (defn, Qnil)); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); if (CONSP (XSYMBOL (fn_name)->function) @@ -742,8 +749,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, Fcons (doc, tail)); defn = Fcons (Qlambda, tail); - if (! NILP (Vinternal_interpreter_environment)) - defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn)); + if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ + defn = Ffunction (Fcons (defn, Qnil)); defn = Fcons (Qmacro, defn); if (!NILP (Vpurify_flag)) @@ -888,16 +895,23 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); + + if (SYMBOLP (sym)) + XSYMBOL (sym)->declared_special = 1; } + else if (!NILP (Vinternal_interpreter_environment) + && !XSYMBOL (sym)->declared_special) + /* A simple (defvar foo) with lexical scoping does "nothing" except + declare that var to be dynamically scoped *locally* (i.e. within + the current file or let-block). */ + Vinternal_interpreter_environment = + Fcons (sym, Vinternal_interpreter_environment); else /* Simple (defvar ) should not count as a definition at all. It could get in the way of other definitions, and unloading this package could try to make the variable unbound. */ ; - - if (SYMBOLP (sym)) - XSYMBOL (sym)->declared_special = 1; - + return sym; } @@ -1038,12 +1052,21 @@ usage: (let* VARLIST BODY...) */) val = Feval (Fcar (Fcdr (elt))); } - if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + if (!NILP (lexenv) && SYMBOLP (var) + && !XSYMBOL (var)->declared_special + && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ { - lexenv = Fcons (Fcons (var, val), lexenv); - specbind (Qinternal_interpreter_environment, lexenv); + Lisp_Object newenv + = Fcons (Fcons (var, val), Vinternal_interpreter_environment); + if (EQ (Vinternal_interpreter_environment, lexenv)) + /* Save the old lexical environment on the specpdl stack, + but only for the first lexical binding, since we'll never + need to revert to one of the intermediate ones. */ + specbind (Qinternal_interpreter_environment, newenv); + else + Vinternal_interpreter_environment = newenv; } else specbind (var, val); @@ -1110,7 +1133,9 @@ usage: (let VARLIST BODY...) */) var = SYMBOLP (elt) ? elt : Fcar (elt); tem = temps[argnum++]; - if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + if (!NILP (lexenv) && SYMBOLP (var) + && !XSYMBOL (var)->declared_special + && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (var, tem), lexenv); else @@ -2302,25 +2327,17 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (SYMBOLP (form)) { - /* If there's an active lexical environment, and the variable - isn't declared special, look up its binding in the lexical - environment. */ - if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (form)->declared_special) - { - Lisp_Object lex_binding - = Fassq (form, Vinternal_interpreter_environment); - - /* If we found a lexical binding for FORM, return the value. - Otherwise, we just drop through and look for a dynamic - binding -- the variable isn't declared special, but there's - not much else we can do, and Fsymbol_value will take care - of signaling an error if there is no binding at all. */ - if (CONSP (lex_binding)) - return XCDR (lex_binding); - } - - return Fsymbol_value (form); + /* Look up its binding in the lexical environment. + We do not pay attention to the declared_special flag here, since we + already did that when let-binding the variable. */ + Lisp_Object lex_binding + = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + ? Fassq (form, Vinternal_interpreter_environment) + : Qnil; + if (CONSP (lex_binding)) + return XCDR (lex_binding); + else + return Fsymbol_value (form); } if (!CONSP (form)) @@ -2485,7 +2502,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, } } if (FUNVECP (fun)) - val = apply_lambda (fun, original_args, 1, Qnil); + val = apply_lambda (fun, original_args, Qnil); else { if (EQ (fun, Qunbound)) @@ -2503,7 +2520,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (EQ (funcar, Qmacro)) val = Feval (apply1 (Fcdr (fun), original_args)); else if (EQ (funcar, Qlambda)) - val = apply_lambda (fun, original_args, 1, + val = apply_lambda (fun, original_args, /* Only pass down the current lexical environment if FUN is lexically embedded in FORM. */ (CONSP (original_fun) @@ -2513,7 +2530,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, && CONSP (XCDR (fun)) && CONSP (XCDR (XCDR (fun))) && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) - val = apply_lambda (XCDR (XCDR (fun)), original_args, 1, + val = apply_lambda (XCDR (XCDR (fun)), original_args, XCAR (XCDR (fun))); else xsignal1 (Qinvalid_function, original_fun); @@ -3208,9 +3225,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) return val; } -Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, - Lisp_Object lexenv) +static Lisp_Object +apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) { Lisp_Object args_left; Lisp_Object numargs; @@ -3230,18 +3246,15 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, for (i = 0; i < XINT (numargs);) { tem = Fcar (args_left), args_left = Fcdr (args_left); - if (eval_flag) tem = Feval (tem); + tem = Feval (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } UNGCPRO; - if (eval_flag) - { - backtrace_list->args = arg_vector; - backtrace_list->nargs = i; - } + backtrace_list->args = arg_vector; + backtrace_list->nargs = i; backtrace_list->evalargs = 0; tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); @@ -3387,8 +3400,11 @@ funcall_lambda (Lisp_Object fun, int nargs, val = Qnil; /* Bind the argument. */ - if (!NILP (lexenv) - && SYMBOLP (next) && !XSYMBOL (next)->declared_special) + if (!NILP (lexenv) && SYMBOLP (next) + /* FIXME: there's no good reason to allow dynamic-scoping + on function arguments, other than consistency with let. */ + && !XSYMBOL (next)->declared_special + && NILP (Fmemq (next, Vinternal_interpreter_environment))) /* Lexically bind NEXT by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (next, val), lexenv); else diff --git a/src/lisp.h b/src/lisp.h index 36653e91e4e..aafa3884273 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2985,7 +2985,6 @@ extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); EXFUN (Fdo_auto_save, 2); -extern Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int, Lisp_Object); extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); diff --git a/src/lread.c b/src/lread.c index 83c94b02e23..d85d146b157 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1767,10 +1767,9 @@ readevalloop (Lisp_Object readcharfun, the file's header, or via a buffer-local variable), create an empty lexical environment, otherwise, turn off lexical binding. */ lex_bound = find_symbol_value (Qlexical_binding); - if (NILP (lex_bound) || EQ (lex_bound, Qunbound)) - specbind (Qinternal_interpreter_environment, Qnil); - else - specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil)); + specbind (Qinternal_interpreter_environment, + NILP (lex_bound) || EQ (lex_bound, Qunbound) + ? Qnil : Fcons (Qt, Qnil)); GCPRO4 (sourcename, readfun, start, end); -- cgit v1.2.1 From defb141157dfa37c33cdcbfa4b29c702a8fc9edf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 13 Dec 2010 22:37:44 -0500 Subject: Try and be more careful about propagation of lexical environment. * src/eval.c (apply_lambda, funcall_lambda): Remove lexenv arg. (Feval): Always eval in the empty environment. (eval_sub): New function. Use it for all calls to Feval that should evaluate in the lexical environment of the caller. Pass `closure's as is to apply_lambda. (Ffuncall): Pass `closure's as is to funcall_lambda. (funcall_lambda): Extract lexenv for `closure's, when applicable. Also use lexical scoping for the &rest argument, if applicable. * src/lisp.h (eval_sub): Declare. * src/lread.c (readevalloop): Remove `evalfun' argument. * src/print.c (Fwith_output_to_temp_buffer): * src/data.c (Fsetq_default): Use eval_sub. * lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. --- src/ChangeLog | 16 +++++++ src/bytecode.c | 8 ++-- src/callint.c | 2 +- src/data.c | 2 +- src/eval.c | 133 +++++++++++++++++++++++++++++---------------------------- src/lisp.h | 1 + src/lread.c | 14 +++--- src/minibuf.c | 1 + src/print.c | 2 +- 9 files changed, 98 insertions(+), 81 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 6abdf583b00..c333b6388c6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,19 @@ +2010-12-14 Stefan Monnier + + Try and be more careful about propagation of lexical environment. + * eval.c (apply_lambda, funcall_lambda): Remove lexenv arg. + (Feval): Always eval in the empty environment. + (eval_sub): New function. Use it for all calls to Feval that should + evaluate in the lexical environment of the caller. + Pass `closure's as is to apply_lambda. + (Ffuncall): Pass `closure's as is to funcall_lambda. + (funcall_lambda): Extract lexenv for `closure's, when applicable. + Also use lexical scoping for the &rest argument, if applicable. + * lisp.h (eval_sub): Declare. + * lread.c (readevalloop): Remove `evalfun' argument. + * print.c (Fwith_output_to_temp_buffer): + * data.c (Fsetq_default): Use eval_sub. + 2010-12-13 Stefan Monnier Make the effect of (defvar foo) local. diff --git a/src/bytecode.c b/src/bytecode.c index d94b19b2d07..01fce0577b0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -901,7 +901,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, case Bsave_window_excursion: BEFORE_POTENTIAL_GC (); - TOP = Fsave_window_excursion (TOP); + TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; @@ -915,13 +915,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, Feval, v1); + TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } case Bunwind_protect: - record_unwind_protect (Fprogn, POP); + record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */ break; case Bcondition_case: @@ -930,7 +930,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, handlers = POP; body = POP; BEFORE_POTENTIAL_GC (); - TOP = internal_lisp_condition_case (TOP, body, handlers); + TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } diff --git a/src/callint.c b/src/callint.c index ae11c7cb24d..960158029c3 100644 --- a/src/callint.c +++ b/src/callint.c @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs); + specs = Feval (specs); /* FIXME: lexbind */ UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { diff --git a/src/data.c b/src/data.c index 924a717cf3d..42d9e076e80 100644 --- a/src/data.c +++ b/src/data.c @@ -1452,7 +1452,7 @@ usage: (setq-default [VAR VALUE]...) */) do { - val = Feval (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (Fcdr (args_left))); symbol = XCAR (args_left); Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); diff --git a/src/eval.c b/src/eval.c index 74dd7e63aa1..485ba00c1e4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -178,10 +178,8 @@ int handling_signal; Lisp_Object Vmacro_declaration_function; -static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, - Lisp_Object lexenv); -static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *, - Lisp_Object); +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); +static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; void @@ -308,7 +306,7 @@ usage: (or CONDITIONS...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); if (!NILP (val)) break; args = XCDR (args); @@ -332,7 +330,7 @@ usage: (and CONDITIONS...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); if (NILP (val)) break; args = XCDR (args); @@ -354,11 +352,11 @@ usage: (if COND THEN ELSE...) */) struct gcpro gcpro1; GCPRO1 (args); - cond = Feval (Fcar (args)); + cond = eval_sub (Fcar (args)); UNGCPRO; if (!NILP (cond)) - return Feval (Fcar (Fcdr (args))); + return eval_sub (Fcar (Fcdr (args))); return Fprogn (Fcdr (Fcdr (args))); } @@ -382,7 +380,7 @@ usage: (cond CLAUSES...) */) while (!NILP (args)) { clause = Fcar (args); - val = Feval (Fcar (clause)); + val = eval_sub (Fcar (clause)); if (!NILP (val)) { if (!EQ (XCDR (clause), Qnil)) @@ -408,7 +406,7 @@ usage: (progn BODY...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); args = XCDR (args); } @@ -438,9 +436,9 @@ usage: (prog1 FIRST BODY...) */) do { if (!(argnum++)) - val = Feval (Fcar (args_left)); + val = eval_sub (Fcar (args_left)); else - Feval (Fcar (args_left)); + eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP(args_left)); @@ -473,9 +471,9 @@ usage: (prog2 FORM1 FORM2 BODY...) */) do { if (!(argnum++)) - val = Feval (Fcar (args_left)); + val = eval_sub (Fcar (args_left)); else - Feval (Fcar (args_left)); + eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP (args_left)); @@ -507,10 +505,10 @@ usage: (setq [SYM VAL]...) */) do { - val = Feval (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (Fcdr (args_left))); sym = Fcar (args_left); - /* Like for Feval, we do not check declared_special here since + /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ && SYMBOLP (sym) @@ -870,7 +868,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) } if (NILP (tem)) - Fset_default (sym, Feval (Fcar (tail))); + Fset_default (sym, eval_sub (Fcar (tail))); else { /* Check if there is really a global binding rather than just a let binding that shadows the global unboundness of the var. */ @@ -935,7 +933,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) if (!NILP (Fcdr (Fcdr (Fcdr (args))))) error ("Too many arguments"); - tem = Feval (Fcar (Fcdr (args))); + tem = eval_sub (Fcar (Fcdr (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); @@ -1049,7 +1047,7 @@ usage: (let* VARLIST BODY...) */) else { var = Fcar (elt); - val = Feval (Fcar (Fcdr (elt))); + val = eval_sub (Fcar (Fcdr (elt))); } if (!NILP (lexenv) && SYMBOLP (var) @@ -1117,7 +1115,7 @@ usage: (let VARLIST BODY...) */) else if (! NILP (Fcdr (Fcdr (elt)))) signal_error ("`let' bindings can have only one value-form", elt); else - temps [argnum++] = Feval (Fcar (Fcdr (elt))); + temps [argnum++] = eval_sub (Fcar (Fcdr (elt))); gcpro2.nvars = argnum; } UNGCPRO; @@ -1166,7 +1164,7 @@ usage: (while TEST BODY...) */) test = Fcar (args); body = Fcdr (args); - while (!NILP (Feval (test))) + while (!NILP (eval_sub (test))) { QUIT; Fprogn (body); @@ -1268,7 +1266,7 @@ usage: (catch TAG BODY...) */) struct gcpro gcpro1; GCPRO1 (args); - tag = Feval (Fcar (args)); + tag = eval_sub (Fcar (args)); UNGCPRO; return internal_catch (tag, Fprogn, Fcdr (args)); } @@ -1401,7 +1399,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) int count = SPECPDL_INDEX (); record_unwind_protect (Fprogn, Fcdr (args)); - val = Feval (Fcar (args)); + val = eval_sub (Fcar (args)); return unbind_to (count, val); } @@ -1502,7 +1500,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, h.tag = &c; handlerlist = &h; - val = Feval (bodyform); + val = eval_sub (bodyform); catchlist = c.next; handlerlist = h.next; return val; @@ -2316,6 +2314,16 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) DEFUN ("eval", Feval, Seval, 1, 1, 0, doc: /* Evaluate FORM and return its value. */) (Lisp_Object form) +{ + int count = SPECPDL_INDEX (); + specbind (Qinternal_interpreter_environment, Qnil); + return unbind_to (count, eval_sub (form)); +} + +/* Eval a sub-expression of the current expression (i.e. in the same + lexical scope). */ +Lisp_Object +eval_sub (Lisp_Object form) { Lisp_Object fun, val, original_fun, original_args; Lisp_Object funcar; @@ -2424,7 +2432,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, while (!NILP (args_left)) { - vals[argnum++] = Feval (Fcar (args_left)); + vals[argnum++] = eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); gcpro3.nvars = argnum; } @@ -2445,7 +2453,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, maxargs = XSUBR (fun)->max_args; for (i = 0; i < maxargs; args_left = Fcdr (args_left)) { - argvals[i] = Feval (Fcar (args_left)); + argvals[i] = eval_sub (Fcar (args_left)); gcpro3.nvars = ++i; } @@ -2502,7 +2510,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, } } if (FUNVECP (fun)) - val = apply_lambda (fun, original_args, Qnil); + val = apply_lambda (fun, original_args); else { if (EQ (fun, Qunbound)) @@ -2518,20 +2526,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, goto retry; } if (EQ (funcar, Qmacro)) - val = Feval (apply1 (Fcdr (fun), original_args)); - else if (EQ (funcar, Qlambda)) - val = apply_lambda (fun, original_args, - /* Only pass down the current lexical environment - if FUN is lexically embedded in FORM. */ - (CONSP (original_fun) - ? Vinternal_interpreter_environment - : Qnil)); - else if (EQ (funcar, Qclosure) - && CONSP (XCDR (fun)) - && CONSP (XCDR (XCDR (fun))) - && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) - val = apply_lambda (XCDR (XCDR (fun)), original_args, - XCAR (XCDR (fun))); + val = eval_sub (apply1 (Fcdr (fun), original_args)); + else if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + val = apply_lambda (fun, original_args); else xsignal1 (Qinvalid_function, original_fun); } @@ -3189,7 +3187,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } if (FUNVECP (fun)) - val = funcall_lambda (fun, numargs, args + 1, Qnil); + val = funcall_lambda (fun, numargs, args + 1); else { if (EQ (fun, Qunbound)) @@ -3199,14 +3197,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); - if (EQ (funcar, Qlambda)) - val = funcall_lambda (fun, numargs, args + 1, Qnil); - else if (EQ (funcar, Qclosure) - && CONSP (XCDR (fun)) - && CONSP (XCDR (XCDR (fun))) - && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) - val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1, - XCAR (XCDR (fun))); + if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -3226,7 +3219,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } static Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) +apply_lambda (Lisp_Object fun, Lisp_Object args) { Lisp_Object args_left; Lisp_Object numargs; @@ -3246,7 +3239,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) for (i = 0; i < XINT (numargs);) { tem = Fcar (args_left), args_left = Fcdr (args_left); - tem = Feval (tem); + tem = eval_sub (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } @@ -3256,7 +3249,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) backtrace_list->args = arg_vector; backtrace_list->nargs = i; backtrace_list->evalargs = 0; - tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); + tem = funcall_lambda (fun, XINT (numargs), arg_vector); /* Do the debug-on-exit now, while arg_vector still exists. */ if (backtrace_list->debug_on_exit) @@ -3321,10 +3314,9 @@ funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args) static Lisp_Object funcall_lambda (Lisp_Object fun, int nargs, - register Lisp_Object *arg_vector, - Lisp_Object lexenv) + register Lisp_Object *arg_vector) { - Lisp_Object val, syms_left, next; + Lisp_Object val, syms_left, next, lexenv; int count = SPECPDL_INDEX (); int i, optional, rest; @@ -3358,6 +3350,14 @@ funcall_lambda (Lisp_Object fun, int nargs, if (CONSP (fun)) { + if (EQ (XCAR (fun), Qclosure)) + { + fun = XCDR (fun); /* Drop `closure'. */ + lexenv = XCAR (fun); + fun = XCDR (fun); /* Drop the lexical environment. */ + } + else + lexenv = Qnil; syms_left = XCDR (fun); if (CONSP (syms_left)) syms_left = XCAR (syms_left); @@ -3365,7 +3365,10 @@ funcall_lambda (Lisp_Object fun, int nargs, xsignal1 (Qinvalid_function, fun); } else if (COMPILEDP (fun)) - syms_left = AREF (fun, COMPILED_ARGLIST); + { + syms_left = AREF (fun, COMPILED_ARGLIST); + lexenv = Qnil; + } else abort (); @@ -3382,23 +3385,21 @@ funcall_lambda (Lisp_Object fun, int nargs, rest = 1; else if (EQ (next, Qand_optional)) optional = 1; - else if (rest) - { - specbind (next, Flist (nargs - i, &arg_vector[i])); - i = nargs; - } else { Lisp_Object val; - - /* Get the argument's actual value. */ - if (i < nargs) + if (rest) + { + val = Flist (nargs - i, &arg_vector[i]); + i = nargs; + } + else if (i < nargs) val = arg_vector[i++]; else if (!optional) xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else val = Qnil; - + /* Bind the argument. */ if (!NILP (lexenv) && SYMBOLP (next) /* FIXME: there's no good reason to allow dynamic-scoping diff --git a/src/lisp.h b/src/lisp.h index aafa3884273..20b50632c49 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2972,6 +2972,7 @@ extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); EXFUN (Feval, 1); +extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); EXFUN (Ffuncall, MANY); EXFUN (Fbacktrace, 0); diff --git a/src/lread.c b/src/lread.c index d85d146b157..550b5f076f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -220,8 +220,7 @@ static Lisp_Object Vbytecomp_version_regexp; static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), Lisp_Object); -static void readevalloop (Lisp_Object, FILE*, Lisp_Object, - Lisp_Object (*) (Lisp_Object), int, +static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object load_unwind (Lisp_Object); @@ -1355,13 +1354,13 @@ Return t if the file exists and loads successfully. */) if (! version || version >= 22) readevalloop (Qget_file_char, stream, hist_file_name, - Feval, 0, Qnil, Qnil, Qnil, Qnil); + 0, Qnil, Qnil, Qnil, Qnil); else { /* We can't handle a file which was compiled with byte-compile-dynamic by older version of Emacs. */ specbind (Qload_force_doc_strings, Qt); - readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval, + readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, 0, Qnil, Qnil, Qnil, Qnil); } unbind_to (count, Qnil); @@ -1726,7 +1725,6 @@ static void readevalloop (Lisp_Object readcharfun, FILE *stream, Lisp_Object sourcename, - Lisp_Object (*evalfun) (Lisp_Object), int printflag, Lisp_Object unibyte, Lisp_Object readfun, Lisp_Object start, Lisp_Object end) @@ -1872,7 +1870,7 @@ readevalloop (Lisp_Object readcharfun, unbind_to (count1, Qnil); /* Now eval what we just read. */ - val = (*evalfun) (val); + val = eval_sub (val); if (printflag) { @@ -1935,7 +1933,7 @@ This function preserves the position of point. */) BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); if (lisp_file_lexically_bound_p (buf)) Fset (Qlexical_binding, Qt); - readevalloop (buf, 0, filename, Feval, + readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -1969,7 +1967,7 @@ This function does not move point. */) specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); /* readevalloop calls functions which check the type of start and end. */ - readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, + readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, !NILP (printflag), Qnil, read_function, start, end); diff --git a/src/minibuf.c b/src/minibuf.c index 0f3def614f2..409f8a9a9ef 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1026,6 +1026,7 @@ is a string to insert in the minibuffer before reading. Such arguments are used as in `read-from-minibuffer'.) */) (Lisp_Object prompt, Lisp_Object initial_contents) { + /* FIXME: lexbind. */ return Feval (read_minibuf (Vread_expression_map, initial_contents, prompt, Qnil, 1, Qread_expression_history, make_number (0), Qnil, 0, 0)); diff --git a/src/print.c b/src/print.c index 77cc2916952..41aa7fc4387 100644 --- a/src/print.c +++ b/src/print.c @@ -652,7 +652,7 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...) */) Lisp_Object buf, val; GCPRO1(args); - name = Feval (Fcar (args)); + name = eval_sub (Fcar (args)); CHECK_STRING (name); temp_output_buffer_setup (SDATA (name)); buf = Vstandard_output; -- cgit v1.2.1 From a0ee6f2751acba71df443d4d795bb350eb6421dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 15 Dec 2010 12:46:59 -0500 Subject: Obey lexical-binding in interactive evaluation commands. * lisp/emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): * lisp/emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1): * lisp/ielm.el (ielm-eval-input): * lisp/simple.el (eval-expression): Use new eval arg to obey lexical-binding. * src/eval.c (Feval): Add `lexical' argument. Adjust callers. (Ffuncall, eval_sub): Avoid goto. --- src/ChangeLog | 5 ++ src/bytecode.c | 2 +- src/callint.c | 2 +- src/doc.c | 2 +- src/eval.c | 267 ++++++++++++++++++++++++++++----------------------------- src/keyboard.c | 12 ++- src/lisp.h | 2 +- src/minibuf.c | 4 +- 8 files changed, 152 insertions(+), 144 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index c333b6388c6..2de6a5ed66c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2010-12-15 Stefan Monnier + + * eval.c (Feval): Add `lexical' argument. Adjust callers. + (Ffuncall, eval_sub): Avoid goto. + 2010-12-14 Stefan Monnier Try and be more careful about propagation of lexical environment. diff --git a/src/bytecode.c b/src/bytecode.c index 01fce0577b0..eb12b9c4963 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -915,7 +915,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ + TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } diff --git a/src/callint.c b/src/callint.c index 960158029c3..5eb65b31cbf 100644 --- a/src/callint.c +++ b/src/callint.c @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs); /* FIXME: lexbind */ + specs = Feval (specs, Qnil); /* FIXME: lexbind */ UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { diff --git a/src/doc.c b/src/doc.c index b887b3149bc..8ae152dca9a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -490,7 +490,7 @@ aren't strings. */) } else if (!STRINGP (tem)) /* Feval protects its argument. */ - tem = Feval (tem); + tem = Feval (tem, Qnil); if (NILP (raw) && STRINGP (tem)) tem = Fsubstitute_command_keys (tem); diff --git a/src/eval.c b/src/eval.c index 485ba00c1e4..7104a8a8396 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2311,12 +2311,14 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) } -DEFUN ("eval", Feval, Seval, 1, 1, 0, - doc: /* Evaluate FORM and return its value. */) - (Lisp_Object form) +DEFUN ("eval", Feval, Seval, 1, 2, 0, + doc: /* Evaluate FORM and return its value. +If LEXICAL is t, evaluate using lexical scoping. */) + (Lisp_Object form, Lisp_Object lexical) { int count = SPECPDL_INDEX (); - specbind (Qinternal_interpreter_environment, Qnil); + specbind (Qinternal_interpreter_environment, + NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); return unbind_to (count, eval_sub (form)); } @@ -2414,10 +2416,8 @@ eval_sub (Lisp_Object form) { backtrace.evalargs = 0; val = (XSUBR (fun)->function.aUNEVALLED) (args_left); - goto done; } - - if (XSUBR (fun)->max_args == MANY) + else if (XSUBR (fun)->max_args == MANY) { /* Pass a vector of evaluated arguments */ Lisp_Object *vals; @@ -2443,73 +2443,74 @@ eval_sub (Lisp_Object form) val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); UNGCPRO; SAFE_FREE (); - goto done; } - - GCPRO3 (args_left, fun, fun); - gcpro3.var = argvals; - gcpro3.nvars = 0; - - maxargs = XSUBR (fun)->max_args; - for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + else { - argvals[i] = eval_sub (Fcar (args_left)); - gcpro3.nvars = ++i; - } - - UNGCPRO; + GCPRO3 (args_left, fun, fun); + gcpro3.var = argvals; + gcpro3.nvars = 0; + + maxargs = XSUBR (fun)->max_args; + for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + { + argvals[i] = eval_sub (Fcar (args_left)); + gcpro3.nvars = ++i; + } + + UNGCPRO; - backtrace.args = argvals; - backtrace.nargs = XINT (numargs); + backtrace.args = argvals; + backtrace.nargs = XINT (numargs); - switch (i) - { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (argvals[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], - argvals[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], - argvals[2], argvals[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6]); - goto done; - - case 8: - val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6], argvals[7]); - goto done; - - default: - /* Someone has created a subr that takes more arguments than - is supported by this code. We need to either rewrite the - subr to use a different argument protocol, or add more - cases to this switch. */ - abort (); + switch (i) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (argvals[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], + argvals[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], + argvals[2], argvals[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6]); + + break; + case 8: + val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6], argvals[7]); + + break; + default: + /* Someone has created a subr that takes more arguments than + is supported by this code. We need to either rewrite the + subr to use a different argument protocol, or add more + cases to this switch. */ + abort (); + } } } - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = apply_lambda (fun, original_args); else { @@ -2533,7 +2534,6 @@ eval_sub (Lisp_Object form) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; @@ -3109,7 +3109,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (SUBRP (fun)) { - if (numargs < XSUBR (fun)->min_args + if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); @@ -3119,74 +3119,72 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (XSUBR (fun)->max_args == UNEVALLED) xsignal1 (Qinvalid_function, original_fun); - if (XSUBR (fun)->max_args == MANY) - { - val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); - goto done; - } - - if (XSUBR (fun)->max_args > numargs) - { - internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); - memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); - for (i = numargs; i < XSUBR (fun)->max_args; i++) - internal_args[i] = Qnil; - } + else if (XSUBR (fun)->max_args == MANY) + val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); else - internal_args = args + 1; - switch (XSUBR (fun)->max_args) { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (internal_args[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], - internal_args[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6]); - goto done; - - case 8: - val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6], internal_args[7]); - goto done; - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - abort (); + if (XSUBR (fun)->max_args > numargs) + { + internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); + memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); + for (i = numargs; i < XSUBR (fun)->max_args; i++) + internal_args[i] = Qnil; + } + else + internal_args = args + 1; + switch (XSUBR (fun)->max_args) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (internal_args[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], + internal_args[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6]); + break; + + case 8: + val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6], internal_args[7]); + break; + + default: + + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + abort (); + } } } - - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { @@ -3209,7 +3207,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; if (backtrace.debug_on_exit) diff --git a/src/keyboard.c b/src/keyboard.c index 17819170640..df69c526f71 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1327,7 +1327,7 @@ command_loop_2 (Lisp_Object ignore) Lisp_Object top_level_2 (void) { - return Feval (Vtop_level); + return Feval (Vtop_level, Qnil); } Lisp_Object @@ -3255,7 +3255,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event help_form_saved_window_configs); record_unwind_protect (read_char_help_form_unwind, Qnil); - tem0 = Feval (Vhelp_form); + tem0 = Feval (Vhelp_form, Qnil); if (STRINGP (tem0)) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); @@ -7696,6 +7696,12 @@ menu_item_eval_property_1 (Lisp_Object arg) return Qnil; } +static Lisp_Object +eval_dyn (Lisp_Object form) +{ + return Feval (form, Qnil); +} + /* Evaluate an expression and return the result (or nil if something went wrong). Used to evaluate dynamic parts of menu items. */ Lisp_Object @@ -7704,7 +7710,7 @@ menu_item_eval_property (Lisp_Object sexpr) int count = SPECPDL_INDEX (); Lisp_Object val; specbind (Qinhibit_redisplay, Qt); - val = internal_condition_case_1 (Feval, sexpr, Qerror, + val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, menu_item_eval_property_1); return unbind_to (count, val); } diff --git a/src/lisp.h b/src/lisp.h index 20b50632c49..db78996be55 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2971,7 +2971,7 @@ extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RET extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); -EXFUN (Feval, 1); +EXFUN (Feval, 2); extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); EXFUN (Ffuncall, MANY); diff --git a/src/minibuf.c b/src/minibuf.c index 409f8a9a9ef..9dd32a8bab4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1026,10 +1026,10 @@ is a string to insert in the minibuffer before reading. Such arguments are used as in `read-from-minibuffer'.) */) (Lisp_Object prompt, Lisp_Object initial_contents) { - /* FIXME: lexbind. */ return Feval (read_minibuf (Vread_expression_map, initial_contents, prompt, Qnil, 1, Qread_expression_history, - make_number (0), Qnil, 0, 0)); + make_number (0), Qnil, 0, 0), + Qnil); } /* Functions that use the minibuffer to read various things. */ -- cgit v1.2.1 From 590130fb19e1f433965c421d98fedeb2d7c33310 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 27 Dec 2010 12:55:38 -0500 Subject: * src/eval.c (Fdefvar): Record specialness before computing initial value. * lisp/emacs-lisp/bytecomp.el (byte-compile-track-mouse): Don't use #'. --- src/ChangeLog | 4 ++++ src/eval.c | 7 ++++--- 2 files changed, 8 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 2de6a5ed66c..f7a3fcc8b1b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-12-27 Stefan Monnier + + * eval.c (Fdefvar): Record specialness before computing initial value. + 2010-12-15 Stefan Monnier * eval.c (Feval): Add `lexical' argument. Adjust callers. diff --git a/src/eval.c b/src/eval.c index 7104a8a8396..36acca01c8b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -855,6 +855,10 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); if (!NILP (tail)) { + if (SYMBOLP (sym)) + /* Do it before evaluating the initial value, for self-references. */ + XSYMBOL (sym)->declared_special = 1; + if (SYMBOL_CONSTANT_P (sym)) { /* For upward compatibility, allow (defvar :foo (quote :foo)). */ @@ -893,9 +897,6 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); - - if (SYMBOLP (sym)) - XSYMBOL (sym)->declared_special = 1; } else if (!NILP (Vinternal_interpreter_environment) && !XSYMBOL (sym)->declared_special) -- cgit v1.2.1 From ce5b520a3758e22c6516e0d864d8c1a3512bf457 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Feb 2011 00:53:30 -0500 Subject: * lisp/emacs-lisp/byte-lexbind.el: Delete. * lisp/emacs-lisp/bytecomp.el (byte-compile-current-heap-environment) (byte-compile-current-num-closures): Remove vars. (byte-vec-ref, byte-vec-set): Remove byte codes. (byte-compile-arglist-vars, byte-compile-make-lambda-lexenv): Move from byte-lexbind.el. (byte-compile-lambda): Never build a closure. (byte-compile-closure-code-p, byte-compile-make-closure): Remove. (byte-compile-closure): Simplify. (byte-compile-top-level): Don't mess with heap environments. (byte-compile-dynamic-variable-bind): Always maintain byte-compile-bound-variables. (byte-compile-variable-ref, byte-compile-variable-set): Always just use the stack for lexical vars. (byte-compile-push-binding-init): Simplify. (byte-compile-not-lexical-var-p): New function, moved from cconv.el. (byte-compile-bind, byte-compile-unbind): New functions, moved and simplified from byte-lexbind.el. (byte-compile-let, byte-compile-let*): Simplify. (byte-compile-condition-case): Don't add :fun-body to the bound vars. (byte-compile-defmacro): Simplify. * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops) (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set. * lisp/emacs-lisp/cconv.el (cconv-not-lexical-var-p): Remove. (cconv-freevars, cconv-analyse-function, cconv-analyse-form): Use byte-compile-not-lexical-var-p instead. * src/bytecode.c (Bvec_ref, Bvec_set): Remove. (exec_byte_code): Don't handle them. * lisp/help-fns.el (describe-function-1): Fix paren typo. --- src/ChangeLog | 5 +++++ src/bytecode.c | 23 ----------------------- 2 files changed, 5 insertions(+), 23 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index f7a3fcc8b1b..6674fb31ca5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-02-12 Stefan Monnier + + * bytecode.c (Bvec_ref, Bvec_set): Remove. + (exec_byte_code): Don't handle them. + 2010-12-27 Stefan Monnier * eval.c (Fdefvar): Record specialness before computing initial value. diff --git a/src/bytecode.c b/src/bytecode.c index 96d2aa273f2..9bf6ae45ce9 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -231,8 +231,6 @@ extern Lisp_Object Qand_optional, Qand_rest; /* Bstack_ref is code 0. */ #define Bstack_set 0262 #define Bstack_set2 0263 -#define Bvec_ref 0264 -#define Bvec_set 0265 #define BdiscardN 0266 #define Bconstant 0300 @@ -1722,27 +1720,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, case Bstack_set2: stack.bottom[FETCH2] = POP; break; - case Bvec_ref: - case Bvec_set: - /* These byte-codes used mostly for variable references to - lexically bound variables that are in an environment vector - instead of on the byte-interpreter stack (generally those - variables which might be shared with a closure). */ - { - int index = FETCH; - Lisp_Object vec = POP; - - if (! VECTORP (vec)) - wrong_type_argument (Qvectorp, vec); - else if (index < 0 || index >= XVECTOR (vec)->size) - args_out_of_range (vec, make_number (index)); - - if (op == Bvec_ref) - PUSH (XVECTOR (vec)->contents[index]); - else - XVECTOR (vec)->contents[index] = POP; - } - break; case BdiscardN: op = FETCH; if (op & 0x80) -- cgit v1.2.1 From b38b1ec071ee9752da53f2485902165fe728e8fa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Feb 2011 16:19:13 -0500 Subject: Various compiler bug-fixes. MPC seems to run correctly now. * lisp/files.el (lexical-binding): Add a safe-local-variable property. * lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Check how many elements are added to the stack. (byte-compile-splice-in-already-compiled-code): Don't touch lexical nor byte-compile-depth now that byte-inline-lapcode does it for us. (byte-compile-inline-expand): Don't inline dynbind byte code into lexbind code, since it has to be done differently. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): Correctly extract arglist from `closure's. (byte-compile-cl-warn): Compiler-macros are run earlier now. (byte-compile-top-level): Bind byte-compile-lexical-environment to nil, except for lambdas. (byte-compile-form): Don't run the compiler-macro expander here. (byte-compile-let): Merge with byte-compile-let*. Don't preserve-body-value if the body's value was discarded. * lisp/emacs-lisp/cconv.el (cconv--set-diff, cconv--set-diff-map) (cconv--map-diff, cconv--map-diff-elem, cconv--map-diff-set): New funs. (cconv--env-var): New constant. (cconv-closure-convert-rec): Use it and use them. Fix a typo that ended up forgetting to remove entries from lmenvs in `let'. For `lambda' use the outer `fvrs' when building the closure and don't forget to remove `vars' from the `emvrs' and `lmenvs' of the body. * lisp/emacs-lisp/cl-macs.el (cl-byte-compile-block): Disable optimization in lexbind, because it needs a different implementation. * src/bytecode.c (exec_byte_code): Fix handling of &rest. * src/eval.c (Vinternal_interpreter_environment): Remove. (syms_of_eval): Do declare Vinternal_interpreter_environment as a global lisp var, but unintern it to hide it. (Fcommandp): * src/data.c (Finteractive_form): Understand `closure's. --- src/ChangeLog | 10 ++++++++++ src/bytecode.c | 4 +++- src/data.c | 2 ++ src/eval.c | 34 ++++++++++++++++++---------------- src/lisp.h | 2 +- 5 files changed, 34 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 6674fb31ca5..0b2ee8550ca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2011-02-17 Stefan Monnier + + * eval.c (Vinternal_interpreter_environment): Remove. + (syms_of_eval): Do declare Vinternal_interpreter_environment as + a global lisp var, but unintern it to hide it. + (Fcommandp): + * data.c (Finteractive_form): Understand `closure's. + + * bytecode.c (exec_byte_code): Fix handling of &rest. + 2011-02-12 Stefan Monnier * bytecode.c (Bvec_ref, Bvec_set): Remove. diff --git a/src/bytecode.c b/src/bytecode.c index 9bf6ae45ce9..1ad01aaf8f7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -500,7 +500,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, optional = 1; else if (EQ (XCAR (at), Qand_rest)) { - PUSH (Flist (nargs, args)); + PUSH (pushed < nargs + ? Flist (nargs - pushed, args) + : Qnil); pushed = nargs; at = Qnil; break; diff --git a/src/data.c b/src/data.c index 83da3e103cb..2f17edd3fdc 100644 --- a/src/data.c +++ b/src/data.c @@ -755,6 +755,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qclosure)) + fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) diff --git a/src/eval.c b/src/eval.c index 9adfc983ced..63484d40e1b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -78,16 +78,6 @@ Lisp_Object Vrun_hooks; Lisp_Object Vautoload_queue; -/* When lexical binding is being used, this is non-nil, and contains an - alist of lexically-bound variable, or (t), indicating an empty - environment. The lisp name of this variable is - `internal-interpreter-environment'. Every element of this list - can be either a cons (VAR . VAL) specifying a lexical binding, - or a single symbol VAR indicating that this variable should use - dynamic scoping. */ - -Lisp_Object Vinternal_interpreter_environment; - /* Current number of specbindings allocated in specpdl. */ EMACS_INT specpdl_size; @@ -2092,9 +2082,11 @@ then strings and vectors are not accepted. */) if (!CONSP (fun)) return Qnil; funcar = XCAR (fun); + if (EQ (funcar, Qclosure)) + fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; - if (EQ (funcar, Qautoload)) + else if (EQ (funcar, Qautoload)) return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; else return Qnil; @@ -3695,6 +3687,8 @@ mark_backtrace (void) } } +EXFUN (Funintern, 2); + void syms_of_eval (void) { @@ -3840,19 +3834,27 @@ DECL is a list `(declare ...)' containing the declarations. The value the function returns is not used. */); Vmacro_declaration_function = Qnil; + /* When lexical binding is being used, + vinternal_interpreter_environment is non-nil, and contains an alist + of lexically-bound variable, or (t), indicating an empty + environment. The lisp name of this variable would be + `internal-interpreter-environment' if it weren't hidden. + Every element of this list can be either a cons (VAR . VAL) + specifying a lexical binding, or a single symbol VAR indicating + that this variable should use dynamic scoping. */ Qinternal_interpreter_environment = intern_c_string ("internal-interpreter-environment"); staticpro (&Qinternal_interpreter_environment); -#if 0 /* Don't export this variable to Elisp, so noone can mess with it - (Just imagine if someone makes it buffer-local). */ - DEFVAR__LISP ("internal-interpreter-environment", - Vinternal_interpreter_environment, + DEFVAR_LISP ("internal-interpreter-environment", + Vinternal_interpreter_environment, doc: /* If non-nil, the current lexical environment of the lisp interpreter. When lexical binding is not being used, this variable is nil. A value of `(t)' indicates an empty environment, otherwise it is an alist of active lexical bindings. */); -#endif Vinternal_interpreter_environment = Qnil; + /* Don't export this variable to Elisp, so noone can mess with it + (Just imagine if someone makes it buffer-local). */ + Funintern (Qinternal_interpreter_environment, Qnil); Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); diff --git a/src/lisp.h b/src/lisp.h index 906736bacad..0e7eeebc9da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2855,7 +2855,7 @@ extern void syms_of_lread (void); /* Defined in eval.c */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; -extern Lisp_Object Qinhibit_quit; +extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern int handling_signal; -- cgit v1.2.1 From e0f57e65692ed73a86926f737388b60faec92767 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 19 Feb 2011 00:10:33 -0500 Subject: * lisp/subr.el (save-window-excursion): New macro, moved from C. * lisp/emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch. * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form): Don't handle save-window-excursion any more. * lisp/emacs-lisp/bytecomp.el (interactive-p, save-window-excursion): Don't use the byte-code any more. (byte-compile-form): Check macro expansion was done. (byte-compile-save-window-excursion): Remove. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Ignore save-window-excursion. Don't macroepand any more. * src/window.c (Fsave_window_excursion): Remove. Moved to Lisp. (syms_of_window): Don't defsubr it. * src/window.h (Fsave_window_excursion): Don't declare it. * src/bytecode.c (exec_byte_code): Inline Fsave_window_excursion. --- src/ChangeLog | 7 +++++++ src/bytecode.c | 32 ++++++++++++++++++++------------ src/window.c | 23 ----------------------- src/window.h | 1 - 4 files changed, 27 insertions(+), 36 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 0b2ee8550ca..6bebce0abaa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-02-19 Stefan Monnier + + * window.c (Fsave_window_excursion): Remove. Moved to Lisp. + (syms_of_window): Don't defsubr it. + * window.h (Fsave_window_excursion): Don't declare it. + * bytecode.c (exec_byte_code): Inline Fsave_window_excursion. + 2011-02-17 Stefan Monnier * eval.c (Vinternal_interpreter_environment): Remove. diff --git a/src/bytecode.c b/src/bytecode.c index 1ad01aaf8f7..ad2f7d18ade 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -138,7 +138,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bpoint 0140 /* Was Bmark in v17. */ -#define Bsave_current_buffer 0141 +#define Bsave_current_buffer 0141 /* Obsolete. */ #define Bgoto_char 0142 #define Binsert 0143 #define Bpoint_max 0144 @@ -158,7 +158,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ #define Bread_char 0162 /* No longer generated as of v19 */ #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ -#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ +#define Binteractive_p 0164 /* Obsolete. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -183,7 +183,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 +#define Bsave_window_excursion 0213 /* Obsolete. */ #define Bsave_restriction 0214 #define Bcatch 0215 @@ -192,7 +192,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Btemp_output_buffer_setup 0220 #define Btemp_output_buffer_show 0221 -#define Bunbind_all 0222 +#define Bunbind_all 0222 /* Obsolete. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: + case Bunbind_all: /* Obsolete. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -891,16 +891,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: + case Bsave_current_buffer: /* Obsolete. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: - BEFORE_POTENTIAL_GC (); - TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ - AFTER_POTENTIAL_GC (); - break; + case Bsave_window_excursion: /* Obsolete. */ + { + register Lisp_Object val; + register int count = SPECPDL_INDEX (); + + record_unwind_protect (Fset_window_configuration, + Fcurrent_window_configuration (Qnil)); + BEFORE_POTENTIAL_GC (); + TOP = Fprogn (TOP); + unbind_to (count, TOP); + AFTER_POTENTIAL_GC (); + break; + } case Bsave_restriction: record_unwind_protect (save_restriction_restore, @@ -1412,7 +1420,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: + case Binteractive_p: /* Obsolete. */ PUSH (Finteractive_p ()); break; diff --git a/src/window.c b/src/window.c index abf01758c3f..c90cc268a92 100644 --- a/src/window.c +++ b/src/window.c @@ -6400,28 +6400,6 @@ redirection (see `redirect-frame-focus'). */) return (tem); } -DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, - 0, UNEVALLED, 0, - doc: /* Execute BODY, preserving window sizes and contents. -Return the value of the last form in BODY. -Restore which buffer appears in which window, where display starts, -and the value of point and mark for each window. -Also restore the choice of selected window. -Also restore which buffer is current. -Does not restore the value of point in current buffer. -usage: (save-window-excursion BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object val; - register int count = SPECPDL_INDEX (); - - record_unwind_protect (Fset_window_configuration, - Fcurrent_window_configuration (Qnil)); - val = Fprogn (args); - return unbind_to (count, val); -} - - /*********************************************************************** Window Split Tree @@ -7195,7 +7173,6 @@ frame to be redrawn only if it is a tty frame. */); defsubr (&Swindow_configuration_frame); defsubr (&Sset_window_configuration); defsubr (&Scurrent_window_configuration); - defsubr (&Ssave_window_excursion); defsubr (&Swindow_tree); defsubr (&Sset_window_margins); defsubr (&Swindow_margins); diff --git a/src/window.h b/src/window.h index 491ffa30bd1..473a43bbc3c 100644 --- a/src/window.h +++ b/src/window.h @@ -860,7 +860,6 @@ EXFUN (Fwindow_minibuffer_p, 1); EXFUN (Fdelete_window, 1); EXFUN (Fwindow_buffer, 1); EXFUN (Fget_buffer_window, 2); -EXFUN (Fsave_window_excursion, UNEVALLED); EXFUN (Fset_window_configuration, 1); EXFUN (Fcurrent_window_configuration, 1); extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); -- cgit v1.2.1 From 3e21b6a72b87787e2327513a44623b250054f77d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 21 Feb 2011 15:12:44 -0500 Subject: Use offsets relative to top rather than bottom for stack refs * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-and-error-free-ops): Remove interactive-p. (byte-optimize-lapcode): Update optimizations now that stack-refs are relative to the top rather than to the bottom. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Turn stack-ref-0 into dup. (byte-compile-form): Don't indirect-function since it can signal errors. (byte-compile-stack-ref, byte-compile-stack-set): Adjust to stack-refs being relative to top rather than to bottom in the byte-code. (with-output-to-temp-buffer): Remove. (byte-compile-with-output-to-temp-buffer): Remove. * lisp/emacs-lisp/cconv.el: Use lexical-binding. (cconv--lookup-let): Rename from cconv-lookup-let. (cconv-closure-convert-rec): Fix handling of captured+mutated arguments in defun/defmacro. * lisp/emacs-lisp/eieio-comp.el (eieio-byte-compile-file-form-defmethod): Rename from byte-compile-file-form-defmethod. Don't byte-compile-lambda. (eieio-byte-compile-defmethod-param-convert): Rename from byte-compile-defmethod-param-convert. * lisp/emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one): Call byte-compile rather than byte-compile-lambda. * src/alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly. * src/bytecode.c (exec_byte_code): Change stack_ref and stack_set to use offsets relative to top rather than to bottom. * lisp/subr.el (with-output-to-temp-buffer): New macro. * lisp/simple.el (count-words-region): Don't use interactive-p. --- src/ChangeLog | 7 +++++++ src/alloc.c | 2 +- src/bytecode.c | 52 +++++++++++++++++++++++++++++++++------------------- src/print.c | 57 +-------------------------------------------------------- src/window.c | 12 +++++++++++- 5 files changed, 53 insertions(+), 77 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 6bebce0abaa..d522b6c55dc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-02-21 Stefan Monnier + + * bytecode.c (exec_byte_code): Change stack_ref and stack_set to use + offsets relative to top rather than to bottom. + + * alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly. + 2011-02-19 Stefan Monnier * window.c (Fsave_window_excursion): Remove. Moved to Lisp. diff --git a/src/alloc.c b/src/alloc.c index 36c849418f3..4c29ce0b4ec 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5029,9 +5029,9 @@ returns nil, because real GC can't be done. */) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); } + mark_byte_stack (); #endif - mark_byte_stack (); for (catch = catchlist; catch; catch = catch->next) { mark_object (catch->tag); diff --git a/src/bytecode.c b/src/bytecode.c index ad2f7d18ade..b2e9e3c5b56 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE */ +#define BYTE_CODE_SAFE /* #define BYTE_CODE_METER */ @@ -88,7 +88,7 @@ extern Lisp_Object Qand_optional, Qand_rest; /* Byte codes: */ -#define Bstack_ref 0 +#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */ #define Bvarref 010 #define Bvarset 020 #define Bvarbind 030 @@ -189,8 +189,8 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bunwind_protect 0216 #define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 -#define Btemp_output_buffer_show 0221 +#define Btemp_output_buffer_setup 0220 /* Obsolete. */ +#define Btemp_output_buffer_show 0221 /* Obsolete. */ #define Bunbind_all 0222 /* Obsolete. */ @@ -898,9 +898,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, case Bsave_window_excursion: /* Obsolete. */ { - register Lisp_Object val; register int count = SPECPDL_INDEX (); - record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); BEFORE_POTENTIAL_GC (); @@ -940,7 +938,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; } - case Btemp_output_buffer_setup: + case Btemp_output_buffer_setup: /* Obsolete. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); @@ -948,7 +946,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = Vstandard_output; break; - case Btemp_output_buffer_show: + case Btemp_output_buffer_show: /* Obsolete. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1710,26 +1708,42 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #endif /* Handy byte-codes for lexical binding. */ - case Bstack_ref: + /* case Bstack_ref: */ /* Use `dup' instead. */ case Bstack_ref+1: case Bstack_ref+2: case Bstack_ref+3: case Bstack_ref+4: case Bstack_ref+5: - PUSH (stack.bottom[op - Bstack_ref]); - break; + { + Lisp_Object *ptr = top - (op - Bstack_ref); + PUSH (*ptr); + break; + } case Bstack_ref+6: - PUSH (stack.bottom[FETCH]); - break; + { + Lisp_Object *ptr = top - (FETCH); + PUSH (*ptr); + break; + } case Bstack_ref+7: - PUSH (stack.bottom[FETCH2]); - break; + { + Lisp_Object *ptr = top - (FETCH2); + PUSH (*ptr); + break; + } + /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */ case Bstack_set: - stack.bottom[FETCH] = POP; - break; + { + Lisp_Object *ptr = top - (FETCH); + *ptr = POP; + break; + } case Bstack_set2: - stack.bottom[FETCH2] = POP; - break; + { + Lisp_Object *ptr = top - (FETCH2); + *ptr = POP; + break; + } case BdiscardN: op = FETCH; if (op & 0x80) diff --git a/src/print.c b/src/print.c index 2c4762047ac..f48b618775d 100644 --- a/src/print.c +++ b/src/print.c @@ -524,6 +524,7 @@ temp_output_buffer_setup (const char *bufname) specbind (Qstandard_output, buf); } +/* FIXME: Use Lisp's with-output-to-temp-buffer instead! */ Lisp_Object internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args) { @@ -545,60 +546,6 @@ internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function return unbind_to (count, val); } - -DEFUN ("with-output-to-temp-buffer", - Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, - 1, UNEVALLED, 0, - doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. - -This construct makes buffer BUFNAME empty before running BODY. -It does not make the buffer current for BODY. -Instead it binds `standard-output' to that buffer, so that output -generated with `prin1' and similar functions in BODY goes into -the buffer. - -At the end of BODY, this marks buffer BUFNAME unmodifed and displays -it in a window, but does not select it. The normal way to do this is -by calling `display-buffer', then running `temp-buffer-show-hook'. -However, if `temp-buffer-show-function' is non-nil, it calls that -function instead (and does not run `temp-buffer-show-hook'). The -function gets one argument, the buffer to display. - -The return value of `with-output-to-temp-buffer' is the value of the -last form in BODY. If BODY does not finish normally, the buffer -BUFNAME is not displayed. - -This runs the hook `temp-buffer-setup-hook' before BODY, -with the buffer BUFNAME temporarily current. It runs the hook -`temp-buffer-show-hook' after displaying buffer BUFNAME, with that -buffer temporarily current, and the window that was used to display it -temporarily selected. But it doesn't run `temp-buffer-show-hook' -if it uses `temp-buffer-show-function'. - -usage: (with-output-to-temp-buffer BUFNAME BODY...) */) - (Lisp_Object args) -{ - struct gcpro gcpro1; - Lisp_Object name; - int count = SPECPDL_INDEX (); - Lisp_Object buf, val; - - GCPRO1(args); - name = eval_sub (Fcar (args)); - CHECK_STRING (name); - temp_output_buffer_setup (SSDATA (name)); - buf = Vstandard_output; - UNGCPRO; - - val = Fprogn (XCDR (args)); - - GCPRO1 (val); - temp_output_buffer_show (buf); - UNGCPRO; - - return unbind_to (count, val); -} - static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag); static void print_preprocess (Lisp_Object obj); @@ -2310,6 +2257,4 @@ priorities. */); print_prune_charset_plist = Qnil; staticpro (&print_prune_charset_plist); - - defsubr (&Swith_output_to_temp_buffer); } diff --git a/src/window.c b/src/window.c index c90cc268a92..d21cbb164ea 100644 --- a/src/window.c +++ b/src/window.c @@ -3655,7 +3655,6 @@ displaying that buffer. */) return Qnil; } - void temp_output_buffer_show (register Lisp_Object buf) { @@ -3715,6 +3714,16 @@ temp_output_buffer_show (register Lisp_Object buf) } } } + +DEFUN ("internal-temp-output-buffer-show", + Ftemp_output_buffer_show, Stemp_output_buffer_show, + 1, 1, 0, + doc: /* Internal function for `with-output-to-temp-buffer''. */) + (Lisp_Object buf) +{ + temp_output_buffer_show (buf); + return Qnil; +} static void make_dummy_parent (Lisp_Object window) @@ -7155,6 +7164,7 @@ frame to be redrawn only if it is a tty frame. */); defsubr (&Sset_window_buffer); defsubr (&Sselect_window); defsubr (&Sforce_window_update); + defsubr (&Stemp_output_buffer_show); defsubr (&Ssplit_window); defsubr (&Senlarge_window); defsubr (&Sshrink_window); -- cgit v1.2.1 From 876c194cbac17a6220dbf406b0a602325978011c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Feb 2011 22:27:45 -0500 Subject: Get rid of funvec. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of `byte-constant'. (byte-compile-close-variables, displaying-byte-compile-warnings): Add edebug spec. (byte-compile-toplevel-file-form): New fun, split out of byte-compile-file-form. (byte-compile-from-buffer): Use it to avoid applying cconv multiple times. (byte-compile): Only strip `function' if it's present. (byte-compile-lambda): Add `reserved-csts' argument. Use new lexenv arg of byte-compile-top-level. (byte-compile-reserved-constants): New var. (byte-compile-constants-vector): Obey it. (byte-compile-constants-vector): Handle new `byte-constant' form. (byte-compile-top-level): Add args `lexenv' and `reserved-csts'. (byte-compile-form): Don't check callargs here. (byte-compile-normal-call): Do it here instead. (byte-compile-push-unknown-constant) (byte-compile-resolve-unknown-constant): Remove, unused. (byte-compile-make-closure): Use `make-byte-code' rather than `curry', putting the environment into the "constant" pool. (byte-compile-get-closed-var): Use special byte-constant. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Handle new intermediate special form `internal-make-vector'. (byte-optimize-lapcode): Handle new form of `byte-constant'. * lisp/help-fns.el (describe-function-1): Don't handle funvecs. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Only convert quote to function if the content is a lambda expression, not if it's a closure. * emacs-lisp/eieio-come.el: Remove. * lisp/emacs-lisp/eieio.el: Don't require eieio-comp. (defmethod): Do a bit more work to find the body and wrap it into a function before passing it to eieio-defmethod. (eieio-defmethod): New arg `code' for it. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in debugger backtrace. * lisp/emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be more careful when quoting a function value. * lisp/emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst. (cconv-closure-convert-rec): Catch stray `internal-make-closure'. * lisp/Makefile.in (COMPILE_FIRST): Compile pcase and cconv early. * src/eval.c (Qcurry): Remove. (funcall_funvec): Remove. (funcall_lambda): Move new byte-code handling to reduce impact. Treat all args as lexical in the case of lexbind. (Fcurry): Remove. * src/data.c (Qfunction_vector): Remove. (Ffunvecp): Remove. * src/lread.c (read1): Revert to calling make_byte_code here. (read_vector): Don't call make_byte_code any more. * src/lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. (XSETCOMPILED): Rename back from XSETFUNVEC. (FUNVEC_SIZE): Remove. (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. (COMPILEDP): Rename back from FUNVECP. * src/fns.c (Felt): Remove unexplained FUNVEC check. * src/doc.c (Fdocumentation): Don't handle funvec. * src/alloc.c (make_funvec, Ffunvec): Remove. * doc/lispref/vol2.texi (Top): * doc/lispref/vol1.texi (Top): * doc/lispref/objects.texi (Programming Types, Funvec Type, Type Predicates): * doc/lispref/functions.texi (Functions, What Is a Function, FunctionCurrying): * doc/lispref/elisp.texi (Top): Remove mentions of funvec and curry. --- src/ChangeLog | 56 ++++++++++++++++++++++ src/ChangeLog.funvec | 37 -------------- src/alloc.c | 71 +++------------------------ src/bytecode.c | 9 +++- src/data.c | 25 +++------- src/doc.c | 5 -- src/eval.c | 133 ++++++++++----------------------------------------- src/fns.c | 25 +++++----- src/image.c | 3 +- src/keyboard.c | 2 +- src/lisp.h | 33 ++----------- src/lread.c | 33 ++++--------- src/print.c | 6 +-- 13 files changed, 133 insertions(+), 305 deletions(-) delete mode 100644 src/ChangeLog.funvec (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index d522b6c55dc..e7902b8c083 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2011-02-25 Stefan Monnier + + * eval.c (Qcurry): Remove. + (funcall_funvec): Remove. + (funcall_lambda): Move new byte-code handling to reduce impact. + Treat all args as lexical in the case of lexbind. + (Fcurry): Remove. + * data.c (Qfunction_vector): Remove. + (Ffunvecp): Remove. + * lread.c (read1): Revert to calling make_byte_code here. + (read_vector): Don't call make_byte_code any more. + * lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. + (XSETCOMPILED): Rename back from XSETFUNVEC. + (FUNVEC_SIZE): Remove. + (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. + (COMPILEDP): Rename back from FUNVECP. + * fns.c (Felt): Remove unexplained FUNVEC check. + * doc.c (Fdocumentation): Don't handle funvec. + * alloc.c (make_funvec, Ffunvec): Remove. + 2011-02-21 Stefan Monnier * bytecode.c (exec_byte_code): Change stack_ref and stack_set to use @@ -113,6 +133,42 @@ Merge funvec patch. +2004-05-20 Miles Bader + + * lisp.h: Declare make_funvec and Ffunvec. + (enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'. + (XSETFUNVEC): Rename from `XSETCOMPILED'. + (FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros. + (COMPILEDP): Define in terms of funvec macros. + (FUNVECP, GC_FUNVECP): Rename from `COMPILEDP' & `GC_COMPILEDP'. + (FUNCTIONP): Use FUNVECP instead of COMPILEDP. + * alloc.c (make_funvec, funvec): New functions. + (Fmake_byte_code): Make sure the first element is a list. + + * eval.c (Qcurry): New variable. + (funcall_funvec, Fcurry): New functions. + (syms_of_eval): Initialize them. + (funcall_lambda): Handle non-bytecode funvec objects by calling + funcall_funvec. + (Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP. + * lread.c (read1): Return result of read_vector for `#[' syntax + directly; read_vector now does any extra work required. + (read_vector): Handle both funvec and byte-code objects, converting the + type as necessary. `bytecodeflag' argument is now called + `read_funvec'. + * data.c (Ffunvecp): New function. + * doc.c (Fdocumentation): Return nil for unknown funvecs. + * fns.c (mapcar1, Felt, concat): Allow funvecs. + + * eval.c (Ffunctionp): Use `funvec' operators instead of `compiled' + operators. + * alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise. + * keyboard.c (Fcommand_execute): Likewise. + * image.c (parse_image_spec): Likewise. + * fns.c (Flength, concat, internal_equal): Likewise. + * data.c (Faref, Ftype_of): Likewise. + * print.c (print_preprocess, print_object): Likewise. + 2004-04-10 Miles Bader * eval.c (Fspecialp): New function. diff --git a/src/ChangeLog.funvec b/src/ChangeLog.funvec deleted file mode 100644 index 098539f1dd9..00000000000 --- a/src/ChangeLog.funvec +++ /dev/null @@ -1,37 +0,0 @@ -2004-05-20 Miles Bader - - * lisp.h: Declare make_funvec and Ffunvec. - (enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'. - (XSETFUNVEC): Renamed from `XSETCOMPILED'. - (FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros. - (COMPILEDP): Define in terms of funvec macros. - (FUNVECP, GC_FUNVECP): Renamed from `COMPILEDP' & `GC_COMPILEDP'. - (FUNCTIONP): Use FUNVECP instead of COMPILEDP. - * alloc.c (make_funvec, funvec): New functions. - (Fmake_byte_code): Make sure the first element is a list. - - * eval.c (Qcurry): New variable. - (funcall_funvec, Fcurry): New functions. - (syms_of_eval): Initialize them. - (funcall_lambda): Handle non-bytecode funvec objects by calling - funcall_funvec. - (Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP. - * lread.c (read1): Return result of read_vector for `#[' syntax - directly; read_vector now does any extra work required. - (read_vector): Handle both funvec and byte-code objects, converting the - type as necessary. `bytecodeflag' argument is now called - `read_funvec'. - * data.c (Ffunvecp): New function. - * doc.c (Fdocumentation): Return nil for unknown funvecs. - * fns.c (mapcar1, Felt, concat): Allow funvecs. - - * eval.c (Ffunctionp): Use `funvec' operators instead of `compiled' - operators. - * alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise. - * keyboard.c (Fcommand_execute): Likewise. - * image.c (parse_image_spec): Likewise. - * fns.c (Flength, concat, internal_equal): Likewise. - * data.c (Faref, Ftype_of): Likewise. - * print.c (print_preprocess, print_object): Likewise. - -;; arch-tag: f35a6a00-4a11-4739-a4b6-9cf98296f315 diff --git a/src/alloc.c b/src/alloc.c index 81a17b5c13b..0b7db7ec627 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2924,37 +2924,6 @@ See also the function `vector'. */) } -/* Return a new `function vector' containing KIND as the first element, - followed by NUM_NIL_SLOTS nil elements, and further elements copied from - the vector PARAMS of length NUM_PARAMS (so the total length of the - resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS). - - If NUM_PARAMS is zero, then PARAMS may be NULL. - - A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. - See the function `funvec' for more detail. */ - -Lisp_Object -make_funvec (Lisp_Object kind, int num_nil_slots, int num_params, - Lisp_Object *params) -{ - int param_index; - Lisp_Object funvec; - - funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil); - - ASET (funvec, 0, kind); - - for (param_index = 0; param_index < num_params; param_index++) - ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]); - - XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC); - XSETFUNVEC (funvec, XVECTOR (funvec)); - - return funvec; -} - - DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -2974,27 +2943,6 @@ usage: (vector &rest OBJECTS) */) } -DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0, - doc: /* Return a newly created `function vector' of type KIND. -A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. -KIND indicates the kind of funvec, and determines its behavior when called. -The meaning of the remaining arguments depends on KIND. Currently -implemented values of KIND, and their meaning, are: - - A list -- A byte-compiled function. See `make-byte-code' for the usual - way to create byte-compiled functions. - - `curry' -- A curried function. Remaining arguments are a function to - call, and arguments to prepend to user arguments at the - time of the call; see the `curry' function. - -usage: (funvec KIND &rest PARAMS) */) - (int nargs, Lisp_Object *args) -{ - return make_funvec (args[0], 0, nargs - 1, args + 1); -} - - DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the arglist, bytecode-string, constant vector, @@ -3008,10 +2956,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT register int index; register struct Lisp_Vector *p; - /* Make sure the arg-list is really a list, as that's what's used to - distinguish a byte-compiled object from other funvecs. */ - CHECK_LIST (args[0]); - XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) val = make_pure_vector ((EMACS_INT) nargs); @@ -3033,8 +2977,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } - XSETPVECTYPE (p, PVEC_FUNVEC); - XSETFUNVEC (val, p); + XSETPVECTYPE (p, PVEC_COMPILED); + XSETCOMPILED (val, p); return val; } @@ -4817,7 +4761,7 @@ Does not copy symbols. Copies strings without text properties. */) obj = make_pure_string (SSDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj)); - else if (FUNVECP (obj) || VECTORP (obj)) + else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register EMACS_INT i; @@ -4829,10 +4773,10 @@ Does not copy symbols. Copies strings without text properties. */) vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); - if (FUNVECP (obj)) + if (COMPILEDP (obj)) { - XSETPVECTYPE (vec, PVEC_FUNVEC); - XSETFUNVEC (obj, vec); + XSETPVECTYPE (vec, PVEC_COMPILED); + XSETCOMPILED (obj, vec); } else XSETVECTOR (obj, vec); @@ -5418,7 +5362,7 @@ mark_object (Lisp_Object arg) } else if (SUBRP (obj)) break; - else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) + else if (COMPILEDP (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -6320,7 +6264,6 @@ The time is in seconds as a floating point value. */); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); - defsubr (&Sfunvec); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); diff --git a/src/bytecode.c b/src/bytecode.c index 639c543dbf9..464bc3d12de 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE 1 */ +/* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ @@ -1720,8 +1720,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; #endif + case 0: + /* Actually this is Bstack_ref with offset 0, but we use Bdup + for that instead. */ + /* case Bstack_ref: */ + abort (); + /* Handy byte-codes for lexical binding. */ - /* case Bstack_ref: */ /* Use `dup' instead. */ case Bstack_ref+1: case Bstack_ref+2: case Bstack_ref+3: diff --git a/src/data.c b/src/data.c index ecedba24101..186e9cb9859 100644 --- a/src/data.c +++ b/src/data.c @@ -84,7 +84,7 @@ static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; Lisp_Object Qwindow; static Lisp_Object Qfloat, Qwindow_configuration; Lisp_Object Qprocess; -static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector; +static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; @@ -194,11 +194,8 @@ for example, (type-of 1) returns `integer'. */) return Qwindow; if (SUBRP (object)) return Qsubr; - if (FUNVECP (object)) - if (FUNVEC_COMPILED_P (object)) - return Qcompiled_function; - else - return Qfunction_vector; + if (COMPILEDP (object)) + return Qcompiled_function; if (BUFFERP (object)) return Qbuffer; if (CHAR_TABLE_P (object)) @@ -397,13 +394,6 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, return Qnil; } -DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0, - doc: /* Return t if OBJECT is a `function vector' object. */) - (Lisp_Object object) -{ - return FUNVECP (object) ? Qt : Qnil; -} - DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, doc: /* Return t if OBJECT is a character or a string. */) (register Lisp_Object object) @@ -2113,9 +2103,9 @@ or a byte-code object. IDX starts at 0. */) { int size = 0; if (VECTORP (array)) - size = ASIZE (array); - else if (FUNVECP (array)) - size = FUNVEC_SIZE (array); + size = XVECTOR (array)->size; + else if (COMPILEDP (array)) + size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK; else wrong_type_argument (Qarrayp, array); @@ -3180,7 +3170,6 @@ syms_of_data (void) Qwindow = intern_c_string ("window"); /* Qsubr = intern_c_string ("subr"); */ Qcompiled_function = intern_c_string ("compiled-function"); - Qfunction_vector = intern_c_string ("function-vector"); Qbuffer = intern_c_string ("buffer"); Qframe = intern_c_string ("frame"); Qvector = intern_c_string ("vector"); @@ -3206,7 +3195,6 @@ syms_of_data (void) staticpro (&Qwindow); /* staticpro (&Qsubr); */ staticpro (&Qcompiled_function); - staticpro (&Qfunction_vector); staticpro (&Qbuffer); staticpro (&Qframe); staticpro (&Qvector); @@ -3243,7 +3231,6 @@ syms_of_data (void) defsubr (&Smarkerp); defsubr (&Ssubrp); defsubr (&Sbyte_code_function_p); - defsubr (&Sfunvecp); defsubr (&Schar_or_string_p); defsubr (&Scar); defsubr (&Scdr); diff --git a/src/doc.c b/src/doc.c index 834321108b5..de20edb2d98 100644 --- a/src/doc.c +++ b/src/doc.c @@ -357,11 +357,6 @@ string is passed through `substitute-command-keys'. */) else return Qnil; } - else if (FUNVECP (fun)) - { - /* Unless otherwise handled, funvecs have no documentation. */ - return Qnil; - } else if (STRINGP (fun) || VECTORP (fun)) { return build_string ("Keyboard macro."); diff --git a/src/eval.c b/src/eval.c index 63484d40e1b..869d70e3d7f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -60,7 +60,6 @@ Lisp_Object Qinhibit_quit; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; -Lisp_Object Qcurry; Lisp_Object Qinternal_interpreter_environment, Qclosure; Lisp_Object Qdebug; @@ -2405,7 +2404,7 @@ eval_sub (Lisp_Object form) } } } - else if (FUNVECP (fun)) + else if (COMPILEDP (fun)) val = apply_lambda (fun, original_args); else { @@ -2890,7 +2889,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, if (SUBRP (object)) return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil; - else if (FUNVECP (object)) + else if (COMPILEDP (object)) return Qt; else if (CONSP (object)) { @@ -3034,7 +3033,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } } } - else if (FUNVECP (fun)) + else if (COMPILEDP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { @@ -3107,54 +3106,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) return tem; } - -/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of - length NARGS). */ - -static Lisp_Object -funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args) -{ - int size = FUNVEC_SIZE (fun); - Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil); - - if (EQ (tag, Qcurry)) - { - /* A curried function is a way to attach arguments to a another - function. The first element of the vector is the identifier - `curry', the second is the wrapped function, and remaining - elements are the attached arguments. */ - int num_curried_args = size - 2; - /* Offset of the curried and user args in the final arglist. Curried - args are first in the new arg vector, after the function. User - args follow. */ - int curried_args_offs = 1; - int user_args_offs = curried_args_offs + num_curried_args; - /* The curried function and arguments. */ - Lisp_Object *curry_params = XVECTOR (fun)->contents + 1; - /* The arguments in the curry vector. */ - Lisp_Object *curried_args = curry_params + 1; - /* The number of arguments with which we'll call funcall, and the - arguments themselves. */ - int num_funcall_args = 1 + num_curried_args + nargs; - Lisp_Object *funcall_args - = (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object)); - - /* First comes the real function. */ - funcall_args[0] = curry_params[0]; - - /* Then the arguments in the appropriate order. */ - memcpy (funcall_args + curried_args_offs, curried_args, - num_curried_args * sizeof (Lisp_Object)); - memcpy (funcall_args + user_args_offs, args, - nargs * sizeof (Lisp_Object)); - - return Ffuncall (num_funcall_args, funcall_args); - } - else - xsignal1 (Qinvalid_function, fun); -} - - /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR and return the result of evaluation. FUN must be either a lambda-expression or a compiled-code object. */ @@ -3167,34 +3118,6 @@ funcall_lambda (Lisp_Object fun, int nargs, int count = SPECPDL_INDEX (); int i, optional, rest; - if (COMPILEDP (fun) - && FUNVEC_SIZE (fun) > COMPILED_PUSH_ARGS - && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS])) - /* A byte-code object with a non-nil `push args' slot means we - shouldn't bind any arguments, instead just call the byte-code - interpreter directly; it will push arguments as necessary. - - Byte-code objects with either a non-existant, or a nil value for - the `push args' slot (the default), have dynamically-bound - arguments, and use the argument-binding code below instead (as do - all interpreted functions, even lexically bound ones). */ - { - /* If we have not actually read the bytecode string - and constants vector yet, fetch them from the file. */ - if (CONSP (AREF (fun, COMPILED_BYTECODE))) - Ffetch_bytecode (fun); - return exec_byte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - AREF (fun, COMPILED_ARGLIST), - nargs, arg_vector); - } - - if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun)) - /* Byte-compiled functions are handled directly below, but we - call other funvec types via funcall_funvec. */ - return funcall_funvec (fun, nargs, arg_vector); - if (CONSP (fun)) { if (EQ (XCAR (fun), Qclosure)) @@ -3213,6 +3136,27 @@ funcall_lambda (Lisp_Object fun, int nargs, } else if (COMPILEDP (fun)) { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_PUSH_ARGS + && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS])) + /* A byte-code object with a non-nil `push args' slot means we + shouldn't bind any arguments, instead just call the byte-code + interpreter directly; it will push arguments as necessary. + + Byte-code objects with either a non-existant, or a nil value for + the `push args' slot (the default), have dynamically-bound + arguments, and use the argument-binding code below instead (as do + all interpreted functions, even lexically bound ones). */ + { + /* If we have not actually read the bytecode string + and constants vector yet, fetch them from the file. */ + if (CONSP (AREF (fun, COMPILED_BYTECODE))) + Ffetch_bytecode (fun); + return exec_byte_code (AREF (fun, COMPILED_BYTECODE), + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + AREF (fun, COMPILED_ARGLIST), + nargs, arg_vector); + } syms_left = AREF (fun, COMPILED_ARGLIST); lexenv = Qnil; } @@ -3248,11 +3192,7 @@ funcall_lambda (Lisp_Object fun, int nargs, val = Qnil; /* Bind the argument. */ - if (!NILP (lexenv) && SYMBOLP (next) - /* FIXME: there's no good reason to allow dynamic-scoping - on function arguments, other than consistency with let. */ - && !XSYMBOL (next)->declared_special - && NILP (Fmemq (next, Vinternal_interpreter_environment))) + if (!NILP (lexenv) && SYMBOLP (next)) /* Lexically bind NEXT by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (next, val), lexenv); else @@ -3532,24 +3472,6 @@ context where binding is lexical by default. */) -DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0, - doc: /* Return FUN curried with ARGS. -The result is a function-like object that will append any arguments it -is called with to ARGS, and call FUN with the resulting list of arguments. - -For instance: - (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2) -and: - (mapcar (curry 'concat "The ") '("a" "b" "c")) - => ("The a" "The b" "The c") - -usage: (curry FUN &rest ARGS) */) - (int nargs, Lisp_Object *args) -{ - return make_funvec (Qcurry, 0, nargs, args); -} - - DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. */) @@ -3764,9 +3686,6 @@ before making `inhibit-quit' nil. */); Qclosure = intern_c_string ("closure"); staticpro (&Qclosure); - Qcurry = intern_c_string ("curry"); - staticpro (&Qcurry); - Qdebug = intern_c_string ("debug"); staticpro (&Qdebug); @@ -3901,11 +3820,9 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Sfetch_bytecode); - defsubr (&Scurry); defsubr (&Sbacktrace_debug); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); - defsubr (&Scurry); defsubr (&Sspecial_variable_p); defsubr (&Sfunctionp); } diff --git a/src/fns.c b/src/fns.c index 5748c3d6e02..b800846b781 100644 --- a/src/fns.c +++ b/src/fns.c @@ -127,8 +127,8 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, MAX_CHAR); else if (BOOL_VECTOR_P (sequence)) XSETFASTINT (val, XBOOL_VECTOR (sequence)->size); - else if (FUNVECP (sequence)) - XSETFASTINT (val, FUNVEC_SIZE (sequence)); + else if (COMPILEDP (sequence)) + XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (sequence)) { i = 0; @@ -488,7 +488,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) - || FUNVECP (this) || BOOL_VECTOR_P (this))) + || COMPILEDP (this) || BOOL_VECTOR_P (this))) wrong_type_argument (Qsequencep, this); } @@ -512,7 +512,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci Lisp_Object ch; EMACS_INT this_len_byte; - if (VECTORP (this) || FUNVECP (this)) + if (VECTORP (this) || COMPILEDP (this)) for (i = 0; i < len; i++) { ch = AREF (this, i); @@ -1311,9 +1311,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, return Fcar (Fnthcdr (n, sequence)); /* Faref signals a "not array" error, so check here. */ - if (! FUNVECP (sequence)) - CHECK_ARRAY (sequence, Qsequencep); - + CHECK_ARRAY (sequence, Qsequencep); return Faref (sequence, n); } @@ -2092,14 +2090,13 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int if (WINDOW_CONFIGURATIONP (o1)) return compare_window_configurations (o1, o2, 0); - /* Aside from them, only true vectors, char-tables, function vectors, - and fonts (font-spec, font-entity, font-ojbect) are sensible to - compare, so eliminate the others now. */ + /* Aside from them, only true vectors, char-tables, compiled + functions, and fonts (font-spec, font-entity, font-ojbect) + are sensible to compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & (PVEC_FUNVEC - | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE - | PVEC_FONT))) + if (!(size & (PVEC_COMPILED + | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -2302,7 +2299,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ - if (VECTORP (seq) || FUNVECP (seq)) + if (VECTORP (seq) || COMPILEDP (seq)) { for (i = 0; i < leni; i++) { diff --git a/src/image.c b/src/image.c index f4a50e92ab1..a7c6346f62c 100644 --- a/src/image.c +++ b/src/image.c @@ -835,8 +835,9 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, case IMAGE_FUNCTION_VALUE: value = indirect_function (value); + /* FIXME: Shouldn't we use Ffunctionp here? */ if (SUBRP (value) - || FUNVECP (value) + || COMPILEDP (value) || (CONSP (value) && EQ (XCAR (value), Qlambda))) break; return 0; diff --git a/src/keyboard.c b/src/keyboard.c index 1f14af78844..78aa1cfea77 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10179,7 +10179,7 @@ a special event, so ignore the prefix argument and don't clear it. */) return Fexecute_kbd_macro (final, prefixarg, Qnil); } - if (CONSP (final) || SUBRP (final) || FUNVECP (final)) + if (CONSP (final) || SUBRP (final) || COMPILEDP (final)) /* Don't call Fcall_interactively directly because we want to make sure the backtrace has an entry for `call-interactively'. For the same reason, pass `cmd' rather than `final'. */ diff --git a/src/lisp.h b/src/lisp.h index badeb4258fb..223cdbc92f0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -349,7 +349,7 @@ enum pvec_type PVEC_NORMAL_VECTOR = 0, PVEC_PROCESS = 0x200, PVEC_FRAME = 0x400, - PVEC_FUNVEC = 0x800, + PVEC_COMPILED = 0x800, PVEC_WINDOW = 0x1000, PVEC_WINDOW_CONFIGURATION = 0x2000, PVEC_SUBR = 0x4000, @@ -607,7 +607,7 @@ extern Lisp_Object make_number (EMACS_INT); #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) -#define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC)) +#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) @@ -623,9 +623,6 @@ extern Lisp_Object make_number (EMACS_INT); eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \ AREF ((ARRAY), (IDX)) = (VAL)) -/* Return the size of the psuedo-vector object FUNVEC. */ -#define FUNVEC_SIZE(funvec) (ASIZE (funvec) & PSEUDOVECTOR_SIZE_MASK) - /* Convenience macros for dealing with Lisp strings. */ #define SDATA(string) (XSTRING (string)->data + 0) @@ -1474,7 +1471,7 @@ struct Lisp_Float typedef unsigned char UCHAR; #endif -/* Meanings of slots in a byte-compiled function vector: */ +/* Meanings of slots in a Lisp_Compiled: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 @@ -1484,24 +1481,6 @@ typedef unsigned char UCHAR; #define COMPILED_INTERACTIVE 5 #define COMPILED_PUSH_ARGS 6 -/* Return non-zero if TAG, the first element from a funvec object, refers - to a byte-code object. Byte-code objects are distinguished from other - `funvec' objects by having a (possibly empty) list as their first - element -- other funvec types use a non-nil symbol there. */ -#define FUNVEC_COMPILED_TAG_P(tag) \ - (NILP (tag) || CONSP (tag)) - -/* Return non-zero if FUNVEC, which should be a `funvec' object, is a - byte-compiled function. Byte-compiled function are funvecs with the - arglist as the first element (other funvec types will have a symbol - identifying the type as the first object). */ -#define FUNVEC_COMPILED_P(funvec) \ - (FUNVEC_SIZE (funvec) > 0 && FUNVEC_COMPILED_TAG_P (AREF (funvec, 0))) - -/* Return non-zero if OBJ is byte-compile function. */ -#define COMPILEDP(obj) \ - (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) - /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE (MUlti-Lingual Emacs) might need 22 bits for the character value @@ -1657,7 +1636,7 @@ typedef struct { #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC) +#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) @@ -1851,7 +1830,7 @@ typedef struct { #define FUNCTIONP(OBJ) \ ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ - || FUNVECP (OBJ) \ + || COMPILEDP (OBJ) \ || SUBRP (OBJ)) /* defsubr (Sname); @@ -2725,7 +2704,6 @@ EXFUN (Fmake_list, 2); extern Lisp_Object allocate_misc (void); EXFUN (Fmake_vector, 2); EXFUN (Fvector, MANY); -EXFUN (Ffunvec, MANY); EXFUN (Fmake_symbol, 1); EXFUN (Fmake_marker, 0); EXFUN (Fmake_string, 2); @@ -2745,7 +2723,6 @@ extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_pure_vector (EMACS_INT); EXFUN (Fgarbage_collect, 0); -extern Lisp_Object make_funvec (Lisp_Object, int, int, Lisp_Object *); 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 b30a75b67c3..77b397a03df 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2497,8 +2497,14 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) invalid_syntax ("#&...", 5); } if (c == '[') - /* `function vector' objects, including byte-compiled functions. */ - return read_vector (readcharfun, 1); + { + /* Accept compiled functions at read-time so that we don't have to + build them using function calls. */ + Lisp_Object tmp; + tmp = read_vector (readcharfun, 1); + return Fmake_byte_code (XVECTOR (tmp)->size, + XVECTOR (tmp)->contents); + } if (c == '(') { Lisp_Object tmp; @@ -3311,7 +3317,7 @@ isfloat_string (const char *cp, int ignore_trailing) static Lisp_Object -read_vector (Lisp_Object readcharfun, int read_funvec) +read_vector (Lisp_Object readcharfun, int bytecodeflag) { register int i; register int size; @@ -3319,11 +3325,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec) register Lisp_Object tem, item, vector; register struct Lisp_Cons *otem; Lisp_Object len; - /* If we're reading a funvec object we start out assuming it's also a - byte-code object (a subset of funvecs), so we can do any special - processing needed. If it's just an ordinary funvec object, we'll - realize that as soon as we've read the first element. */ - int read_bytecode = read_funvec; tem = read_list (1, readcharfun); len = Flength (tem); @@ -3335,18 +3336,11 @@ read_vector (Lisp_Object readcharfun, int read_funvec) { item = Fcar (tem); - /* If READ_BYTECODE is set, check whether this is really a byte-code - object, or just an ordinary `funvec' object -- non-byte-code - funvec objects use the same reader syntax. We can tell from the - first element which one it is. */ - if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item)) - read_bytecode = 0; /* Nope. */ - /* If `load-force-doc-strings' is t when reading a lazily-loaded bytecode object, the docstring containing the bytecode and constants values must be treated as unibyte and passed to Fread, to get the actual bytecode string and constants vector. */ - if (read_bytecode && load_force_doc_strings) + if (bytecodeflag && load_force_doc_strings) { if (i == COMPILED_BYTECODE) { @@ -3400,13 +3394,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec) free_cons (otem); } - if (read_bytecode && size >= 4) - /* Convert this vector to a bytecode object. */ - vector = Fmake_byte_code (size, XVECTOR (vector)->contents); - else if (read_funvec && size >= 1) - /* Convert this vector to an ordinary funvec object. */ - XSETFUNVEC (vector, XVECTOR (vector)); - return vector; } diff --git a/src/print.c b/src/print.c index 11bce153ffc..00847d67318 100644 --- a/src/print.c +++ b/src/print.c @@ -1155,7 +1155,7 @@ print_preprocess (Lisp_Object obj) loop: if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -1337,7 +1337,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag /* Detect circularities and truncate them. */ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -1960,7 +1960,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag else { EMACS_INT size = XVECTOR (obj)->size; - if (FUNVECP (obj)) + if (COMPILEDP (obj)) { PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; -- cgit v1.2.1 From a9de04fa62f123413d82b7b7b1e7a77705eb82dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 Feb 2011 10:19:08 -0500 Subject: Compute freevars in cconv-analyse. * lisp/emacs-lisp/cconv.el: Compute freevars in cconv-analyse. (cconv-mutated, cconv-captured): Remove. (cconv-captured+mutated, cconv-lambda-candidates): Don't give them a global value. (cconv-freevars-alist): New var. (cconv-freevars): Remove. (cconv--lookup-let): Remove. (cconv-closure-convert-function): Extract from cconv-closure-convert-rec. (cconv-closure-convert-rec): Adjust to above changes. (fboundp): New function. (cconv-analyse-function, form): Rewrite. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Handle declare-function here. (byte-compile-obsolete): Remove. (byte-compile-arglist-warn): Check late defsubst here. (byte-compile-file-form): Simplify. (byte-compile-file-form-defsubst): Remove. (byte-compile-macroexpand-declare-function): Rename from byte-compile-declare-function, turn it into a macro-expander. (byte-compile-normal-call): Check obsolescence. (byte-compile-quote-form): Remove. (byte-compile-defmacro): Revert to trunk's definition which seems to work just as well and handles `declare'. * lisp/emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile. * lisp/Makefile.in (BIG_STACK_DEPTH): Increase to 1200. (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp". * lisp/emacs-lisp/macroexp.el: Use lexbind. (macroexpand-all-1): Check macro obsolescence. * lisp/vc/diff-mode.el: Use lexbind. * lisp/follow.el (follow-calc-win-end): Simplify. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/bytecode.c b/src/bytecode.c index 464bc3d12de..9693a5a9196 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE */ +#define BYTE_CODE_SAFE 1 /* #define BYTE_CODE_METER */ -- cgit v1.2.1 From d032d5e7dfabfae60f3304da02c97cd1e189b9a2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 1 Mar 2011 00:03:24 -0500 Subject: * doc/lispref/variables.texi (Scope): Mention the availability of lexbind. (Lexical Binding): New node. * doc/lispref/eval.texi (Eval): Add `eval's new `lexical' arg. * lisp/emacs-lisp/cconv.el (cconv-liftwhen): Increase threshold. (cconv-closure-convert-rec): Convert interactive spec in empty lexenv. (cconv-analyse-use): Improve unused vars warnings. (cconv-analyse-form): Analyze interactive spec in empty lexenv. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Always byte-compile the interactive spec in lexical-binding mode. (byte-compile-refresh-preloaded): Don't reload byte-compiler files. * lisp/custom.el (custom-initialize-default): Use defvar. (custom-declare-variable): Set the special-variable-p flag. * lisp/help-fns.el (help-make-usage): Drop leading underscores. * lisp/dired.el (dired-revert, dired-make-relative): Mark unused args. (dired-unmark-all-files): Remove unused var `query'. (dired-overwrite-confirmed): Declare. (dired-restore-desktop-buffer): Don't use dynamically scoped arg names. * lisp/mpc.el: Mark unused args. (mpc--faster-toggle): Remove unused var `songnb'. * lisp/server.el (server-kill-buffer-running): Move before first use. * lisp/minibuffer.el: Mark unused args. * src/callint.c (quotify_arg): Simplify the logic. (Fcall_interactively): Use lexical binding when evaluating the interactive spec of a lexically bound function. --- src/ChangeLog | 6 ++++++ src/callint.c | 13 ++++++++++--- 2 files changed, 16 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e7902b8c083..c638e1fa4b5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-01 Stefan Monnier + + * callint.c (quotify_arg): Simplify the logic. + (Fcall_interactively): Use lexical binding when evaluating the + interactive spec of a lexically bound function. + 2011-02-25 Stefan Monnier * eval.c (Qcurry): Remove. diff --git a/src/callint.c b/src/callint.c index 253f2b9dd09..a0efc4bbfe4 100644 --- a/src/callint.c +++ b/src/callint.c @@ -121,8 +121,9 @@ usage: (interactive &optional ARGS) */) Lisp_Object quotify_arg (register Lisp_Object exp) { - if (!INTEGERP (exp) && !STRINGP (exp) - && !NILP (exp) && !EQ (exp, Qt)) + if (CONSP (exp) + || (SYMBOLP (exp) + && !NILP (exp) && !EQ (exp, Qt))) return Fcons (Qquote, Fcons (exp, Qnil)); return exp; @@ -169,6 +170,9 @@ check_mark (int for_region) static void fix_command (Lisp_Object input, Lisp_Object values) { + /* FIXME: Instead of this ugly hack, we should provide a way for an + interactive spec to return an expression that will re-build the args + without user intervention. */ if (CONSP (input)) { Lisp_Object car; @@ -331,11 +335,14 @@ invoke it. If KEYS is omitted or nil, the return value of else { Lisp_Object input; + Lisp_Object funval = Findirect_function (function, Qt); i = num_input_events; input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs, Qnil); /* FIXME: lexbind */ + specs = Feval (specs, + CONSP (funval) && EQ (Qclosure, XCAR (funval)) + ? Qt : Qnil); UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { -- cgit v1.2.1 From e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 5 Mar 2011 23:48:17 -0500 Subject: Fix pcase memoizing; change lexbound byte-code marker. * src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling and replace it with the a integer args-desc handling. * eval.c (funcall_lambda): Adjust arglist test accordingly. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Handle integer arglist descriptor. (byte-compile-make-args-desc): Make integer arglist descriptor. (byte-compile-lambda): Use integer arglist descriptor to mark lexical byte-coded functions instead of an extra slot. * lisp/help-fns.el (help-add-fundoc-usage): Don't add a dummy doc. (help-split-fundoc): Return a nil doc if there was no actual doc. (help-function-arglist): Generate an arglist from an integer arg-desc. * lisp/emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize; Make only the key weak. (pcase): Change the key used in the memoization table, so it does not always get GC'd away. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the pcase pattern to generate slightly better code. --- src/ChangeLog | 6 +++++ src/alloc.c | 13 +++++++++-- src/bytecode.c | 71 ++++++++++++++++++++++++++++++++++------------------------ 3 files changed, 59 insertions(+), 31 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index c638e1fa4b5..e8b3c57fbd0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-06 Stefan Monnier + + * bytecode.c (exec_byte_code): Remove old lexical binding slot handling + and replace it with the a integer args-desc handling. + * eval.c (funcall_lambda): Adjust arglist test accordingly. + 2011-03-01 Stefan Monnier * callint.c (quotify_arg): Simplify the logic. diff --git a/src/alloc.c b/src/alloc.c index 0b7db7ec627..c7fd8747f74 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2945,10 +2945,19 @@ usage: (vector &rest OBJECTS) */) DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. -The arguments should be the arglist, bytecode-string, constant vector, -stack size, (optional) doc string, and (optional) interactive spec. +The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant +vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, +and (optional) INTERACTIVE-SPEC. The first four arguments are required; at most six have any significance. +The ARGLIST can be either like the one of `lambda', in which case the arguments +will be dynamically bound before executing the byte code, or it can be an +integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the +minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number +of arguments (ignoring &rest) and the R bit specifies whether there is a &rest +argument to catch the left-over arguments. If such an integer is used, the +arguments will not be dynamically bound but will be instead pushed on the +stack before executing the byte-code. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) (register int nargs, Lisp_Object *args) { diff --git a/src/bytecode.c b/src/bytecode.c index 9693a5a9196..dbab02886e2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -502,37 +502,50 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, stacke = stack.bottom - 1 + XFASTINT (maxdepth); #endif - if (! NILP (args_template)) - /* We should push some arguments on the stack. */ + if (INTEGERP (args_template)) { - Lisp_Object at; - int pushed = 0, optional = 0; - - for (at = args_template; CONSP (at); at = XCDR (at)) - if (EQ (XCAR (at), Qand_optional)) - optional = 1; - else if (EQ (XCAR (at), Qand_rest)) - { - PUSH (pushed < nargs - ? Flist (nargs - pushed, args) - : Qnil); - pushed = nargs; - at = Qnil; - break; - } - else if (pushed < nargs) - { - PUSH (*args++); - pushed++; - } - else if (optional) - PUSH (Qnil); - else - break; - - if (pushed != nargs || !NILP (at)) + int at = XINT (args_template); + int rest = at & 128; + int mandatory = at & 127; + int nonrest = at >> 8; + eassert (mandatory <= nonrest); + if (nargs <= nonrest) + { + int i; + for (i = 0 ; i < nargs; i++, args++) + PUSH (*args); + if (nargs < mandatory) + /* Too few arguments. */ + Fsignal (Qwrong_number_of_arguments, + Fcons (Fcons (make_number (mandatory), + rest ? Qand_rest : make_number (nonrest)), + Fcons (make_number (nargs), Qnil))); + else + { + for (; i < nonrest; i++) + PUSH (Qnil); + if (rest) + PUSH (Qnil); + } + } + else if (rest) + { + int i; + for (i = 0 ; i < nonrest; i++, args++) + PUSH (*args); + PUSH (Flist (nargs - nonrest, args)); + } + else + /* Too many arguments. */ Fsignal (Qwrong_number_of_arguments, - Fcons (args_template, Fcons (make_number (nargs), Qnil))); + Fcons (Fcons (make_number (mandatory), + make_number (nonrest)), + Fcons (make_number (nargs), Qnil))); + } + else if (! NILP (args_template)) + /* We should push some arguments on the stack. */ + { + error ("Unknown args template!"); } while (1) -- cgit v1.2.1 From 798cb64441228d473f7bdd213183c70fb582595c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 6 Mar 2011 00:07:48 -0500 Subject: Missing file in last commit. * src/eval.c (funcall_lambda): Adjust arglist test accordingly. --- src/eval.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/eval.c b/src/eval.c index 869d70e3d7f..1f6a5e4a1c6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3136,8 +3136,8 @@ funcall_lambda (Lisp_Object fun, int nargs, } else if (COMPILEDP (fun)) { - if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_PUSH_ARGS - && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS])) + syms_left = AREF (fun, COMPILED_ARGLIST); + if (INTEGERP (syms_left)) /* A byte-code object with a non-nil `push args' slot means we shouldn't bind any arguments, instead just call the byte-code interpreter directly; it will push arguments as necessary. @@ -3154,10 +3154,9 @@ funcall_lambda (Lisp_Object fun, int nargs, return exec_byte_code (AREF (fun, COMPILED_BYTECODE), AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), - AREF (fun, COMPILED_ARGLIST), + syms_left, nargs, arg_vector); } - syms_left = AREF (fun, COMPILED_ARGLIST); lexenv = Qnil; } else -- cgit v1.2.1 From ba83908c4b7fda12991ae9073028a60da87c1fa2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Mar 2011 15:04:22 -0500 Subject: Misc fixes, and use lexical-binding in more files. * lisp/subr.el (letrec): New macro. (with-wrapper-hook): Move from lisp/simple.el and don't use CL. * simple.el (with-wrapper-hook): Move with-wrapper-hook to subr.el. * lisp/help-fns.el (help-function-arglist): Handle subroutines as well. (describe-variable): Use special-variable-p to filter completions. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Don't expand `declare' in defmacros. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Handle `declare'. * lisp/emacs-lisp/cl.el (pushnew): Silence unfixable warning. * lisp/emacs-lisp/cl-macs.el (defstruct, define-compiler-macro): Mark unused arg as unused. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Use memq. * lisp/emacs-lisp/autoload.el (make-autoload): Don't assume the macro's first sexp is a list. (autoload-generate-file-autoloads): Improve error message. * lisp/emacs-lisp/advice.el (ad-arglist): Use help-function-arglist to understand the new byte-code arg format. * lisp/vc/smerge-mode.el: * lisp/vc/log-view.el: * lisp/vc/log-edit.el: * lisp/vc/cvs-status.el: * lisp/uniquify.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/bibtex-style.el: * lisp/reveal.el: * lisp/newcomment.el: * lisp/emacs-lisp/smie.el: * lisp/abbrev.el: Use lexical-binding. * src/eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. (Fdefvar): Remove redundant SYMBOLP check. (Ffunctionp): Don't signal an error for undefined aliases. * doc/lispref/variables.texi (Converting to Lexical Binding): New node. --- src/ChangeLog | 6 ++++++ src/eval.c | 25 +++++++++++-------------- 2 files changed, 17 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e8b3c57fbd0..bbf7f99bb32 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-11 Stefan Monnier + + * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. + (Fdefvar): Remove redundant SYMBOLP check. + (Ffunctionp): Don't signal an error for undefined aliases. + 2011-03-06 Stefan Monnier * bytecode.c (exec_byte_code): Remove old lexical binding slot handling diff --git a/src/eval.c b/src/eval.c index 1f6a5e4a1c6..36c63a5c8a7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -371,13 +371,12 @@ usage: (prog1 FIRST BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP(args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -406,13 +405,12 @@ usage: (prog2 FORM1 FORM2 BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -791,9 +789,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); if (!NILP (tail)) { - if (SYMBOLP (sym)) - /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; + /* Do it before evaluating the initial value, for self-references. */ + XSYMBOL (sym)->declared_special = 1; if (SYMBOL_CONSTANT_P (sym)) { @@ -2873,7 +2870,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, { if (SYMBOLP (object) && !NILP (Ffboundp (object))) { - object = Findirect_function (object, Qnil); + object = Findirect_function (object, Qt); if (CONSP (object) && EQ (XCAR (object), Qautoload)) { -- cgit v1.2.1 From 23aba0ea0e4922cfd8534f43667d3a758f2d2974 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Mar 2011 18:31:49 -0400 Subject: * src/eval.c (Ffunction): Use simpler format for closures. (Fcommandp, funcall_lambda): * src/doc.c (Fdocumentation, store_function_docstring): * src/data.c (Finteractive_form): * lisp/help-fns.el (help-function-arglist): * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): * lisp/subr.el (apply-partially): Adjust to new closure format. * lisp/emacs-lisp/disass.el (disassemble-internal): Catch closures. --- src/ChangeLog | 7 +++++++ src/data.c | 4 ++-- src/doc.c | 8 +++----- src/eval.c | 9 +++++---- 4 files changed, 17 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index bbf7f99bb32..00d8e4b8ee3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-03-13 Stefan Monnier + + * eval.c (Ffunction): Use simpler format for closures. + (Fcommandp, funcall_lambda): + * doc.c (Fdocumentation, store_function_docstring): + * data.c (Finteractive_form): Adjust to new closure format. + 2011-03-11 Stefan Monnier * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. diff --git a/src/data.c b/src/data.c index 186e9cb9859..6039743b1d5 100644 --- a/src/data.c +++ b/src/data.c @@ -746,8 +746,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) { Lisp_Object funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); + else if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) { diff --git a/src/doc.c b/src/doc.c index de20edb2d98..b56464e7219 100644 --- a/src/doc.c +++ b/src/doc.c @@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */) else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); else if (EQ (funcar, Qlambda) + || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) || EQ (funcar, Qautoload)) { Lisp_Object tem1; @@ -384,8 +385,6 @@ string is passed through `substitute-command-keys'. */) else return Qnil; } - else if (EQ (funcar, Qclosure)) - return Fdocumentation (Fcdr (XCDR (fun)), raw); else if (EQ (funcar, Qmacro)) return Fdocumentation (Fcdr (fun), raw); else @@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) Lisp_Object tem; tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) + if (EQ (tem, Qlambda) || EQ (tem, Qautoload) + || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && INTEGERP (XCAR (tem))) @@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) } else if (EQ (tem, Qmacro)) store_function_docstring (XCDR (fun), offset); - else if (EQ (tem, Qclosure)) - store_function_docstring (Fcdr (XCDR (fun)), offset); } /* Bytecode objects sometimes have slots for it. */ diff --git a/src/eval.c b/src/eval.c index 36c63a5c8a7..2fb89ce404e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -487,7 +487,8 @@ usage: (function ARG) */) && EQ (XCAR (quoted), Qlambda)) /* This is a lambda expression within a lexical environment; return an interpreted closure instead of a simple lambda. */ - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted)); + return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, + XCDR (quoted))); else /* Simply quote the argument. */ return quoted; @@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; @@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs, { fun = XCDR (fun); /* Drop `closure'. */ lexenv = XCAR (fun); - fun = XCDR (fun); /* Drop the lexical environment. */ + CHECK_LIST_CONS (fun, fun); } else lexenv = Qnil; -- cgit v1.2.1 From ca1055060d5793e368c1a165c412944d6800c3a6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 16 Mar 2011 16:08:39 -0400 Subject: Remove bytecomp- prefix, plus misc changes. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Make it work to inline lexbind interpreted functions into lexbind code. (bytedecomp-bytes): Not a dynamic var any more. (disassemble-offset): Get the bytes via an argument instead. (byte-decompile-bytecode-1): Use push. * lisp/emacs-lisp/bytecomp.el: Remove the bytecomp- prefix now that we use lexical-binding. (byte-compile-outbuffer): Rename from bytecomp-outbuffer. * lisp/emacs-lisp/cl-macs.el (load-time-value): * lisp/emacs-lisp/cl.el (cl-compiling-file): Adjust to new name. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add byte-code-function-p. (pcase--u1): Remove left-over code from early development. Fix case of variable shadowing in guards and predicates. (pcase--u1): Add a new `let' pattern. * src/image.c (parse_image_spec): Use Ffunctionp. * src/lisp.h: Declare Ffunctionp. --- src/ChangeLog | 5 +++++ src/bytecode.c | 12 ++++++------ src/image.c | 5 +---- src/lisp.h | 1 + 4 files changed, 13 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 00d8e4b8ee3..e34cd694321 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-03-16 Stefan Monnier + + * image.c (parse_image_spec): Use Ffunctionp. + * lisp.h: Declare Ffunctionp. + 2011-03-13 Stefan Monnier * eval.c (Ffunction): Use simpler format for closures. diff --git a/src/bytecode.c b/src/bytecode.c index b19f9687cdc..ba3c012bd1a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -939,27 +939,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_restriction_save ()); break; - case Bcatch: + case Bcatch: /* FIXME: ill-suited for lexbind */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ + TOP = internal_catch (TOP, eval_sub, v1); AFTER_POTENTIAL_GC (); break; } - case Bunwind_protect: - record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */ + case Bunwind_protect: /* FIXME: avoid closure for lexbind */ + record_unwind_protect (Fprogn, POP); break; - case Bcondition_case: + case Bcondition_case: /* FIXME: ill-suited for lexbind */ { Lisp_Object handlers, body; handlers = POP; body = POP; BEFORE_POTENTIAL_GC (); - TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */ + TOP = internal_lisp_condition_case (TOP, body, handlers); AFTER_POTENTIAL_GC (); break; } diff --git a/src/image.c b/src/image.c index a7c6346f62c..73a45633f3b 100644 --- a/src/image.c +++ b/src/image.c @@ -835,10 +835,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, case IMAGE_FUNCTION_VALUE: value = indirect_function (value); - /* FIXME: Shouldn't we use Ffunctionp here? */ - if (SUBRP (value) - || COMPILEDP (value) - || (CONSP (value) && EQ (XCAR (value), Qlambda))) + if (!NILP (Ffunctionp (value))) break; return 0; diff --git a/src/lisp.h b/src/lisp.h index ece96428253..e4788e63f5b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2864,6 +2864,7 @@ extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fcommandp, 2); +EXFUN (Ffunctionp, 1); EXFUN (Feval, 2); extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); -- cgit v1.2.1 From f488fb6528738131ef41859e1f04125f2e50efce Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 30 Mar 2011 14:40:00 -0400 Subject: * lisp/subr.el (apply-partially): Use a non-nil static environment. (--dolist-tail--, --dotimes-limit--): Don't declare dynamically bound. (dolist): Use a more efficient form for lexical-binding. (dotimes): Use a cleaner semantics for lexical-binding. * lisp/emacs-lisp/edebug.el (edebug-eval-top-level-form): Use eval-sexp-add-defvars. --- src/lread.c | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/lread.c b/src/lread.c index 7a8d7cf9a6a..24183532527 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1889,6 +1889,7 @@ which is the input stream for reading characters. This function does not move point. */) (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { + /* FIXME: Do the eval-sexp-add-defvars danse! */ int count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; -- cgit v1.2.1 From 7200d79c65c65686495dd95e9f6dd436cf6db55e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 1 Apr 2011 11:16:50 -0400 Subject: Miscellanous cleanups in preparation for the merge. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove debug statement. * lisp/emacs-lisp/bytecomp.el (byte-compile-single-version) (byte-compile-version-cond, byte-compile-delay-out) (byte-compile-delayed-out): Remove, unused. * src/bytecode.c (Fbyte_code): Revert to old calling convention. * src/lisp.h (COMPILED_PUSH_ARGS): Remove, unused. --- src/ChangeLog | 5 +++++ src/bytecode.c | 41 ++++++++++++++++------------------------- src/callint.c | 4 ++-- src/eval.c | 15 ++++++--------- src/lisp.h | 3 +-- src/lread.c | 33 +++++++++++++-------------------- src/window.c | 1 + 7 files changed, 44 insertions(+), 58 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e34cd694321..04064adbaa3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-01 Stefan Monnier + + * bytecode.c (Fbyte_code): Revert to old calling convention. + * lisp.h (COMPILED_PUSH_ARGS): Remove, unused. + 2011-03-16 Stefan Monnier * image.c (parse_image_spec): Use Ffunctionp. diff --git a/src/bytecode.c b/src/bytecode.c index 01ae8055ebf..5d94cb0fb39 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -#define BYTE_CODE_SAFE 1 +/* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ @@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #ifdef BYTE_CODE_SAFE #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ #endif -#define Binteractive_p 0164 /* Obsolete. */ +#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 /* Obsolete. */ +#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */ #define Bsave_restriction 0214 #define Bcatch 0215 #define Bunwind_protect 0216 #define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 /* Obsolete. */ -#define Btemp_output_buffer_show 0221 /* Obsolete. */ +#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */ +#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */ -#define Bunbind_all 0222 /* Obsolete. */ +#define Bunbind_all 0222 /* Obsolete. Never used. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -413,24 +413,15 @@ unmark_byte_stack (void) } while (0) -DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0, +DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, doc: /* Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; the second, VECTOR, a vector of constants; the third, MAXDEPTH, the maximum stack depth used in this function. -If the third argument is incorrect, Emacs may crash. - -If ARGS-TEMPLATE is specified, it is an argument list specification, -according to which any remaining arguments are pushed on the stack -before executing BYTESTR. - -usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */) - (size_t nargs, Lisp_Object *args) +If the third argument is incorrect, Emacs may crash. */) + (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) { - Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil; - int pnargs = nargs >= 4 ? nargs - 4 : 0; - Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0; - return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs); + return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and @@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: /* Obsolete. */ + case Bunbind_all: /* Obsolete. Never used. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: /* Obsolete. */ + case Bsave_current_buffer: /* Obsolete since ??. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: /* Obsolete. */ + case Bsave_window_excursion: /* Obsolete since 24.1. */ { register int count = SPECPDL_INDEX (); record_unwind_protect (Fset_window_configuration, @@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; } - case Btemp_output_buffer_setup: /* Obsolete. */ + case Btemp_output_buffer_setup: /* Obsolete since 24.1. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); @@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = Vstandard_output; break; - case Btemp_output_buffer_show: /* Obsolete. */ + case Btemp_output_buffer_show: /* Obsolete since 24.1. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: /* Obsolete. */ + case Binteractive_p: /* Obsolete since 24.1. */ PUSH (Finteractive_p ()); break; diff --git a/src/callint.c b/src/callint.c index 489fa392e46..60570369d9e 100644 --- a/src/callint.c +++ b/src/callint.c @@ -171,8 +171,8 @@ static void fix_command (Lisp_Object input, Lisp_Object values) { /* FIXME: Instead of this ugly hack, we should provide a way for an - interactive spec to return an expression that will re-build the args - without user intervention. */ + interactive spec to return an expression/function that will re-build the + args without user intervention. */ if (CONSP (input)) { Lisp_Object car; diff --git a/src/eval.c b/src/eval.c index 9f90e6df4b5..0e47d7c757c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function; int handling_signal; -static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; static int interactive_p (int); +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); void init_eval_once (void) @@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, tail); else tail = Fcons (lambda_list, Fcons (doc, tail)); - + defn = Fcons (Qlambda, tail); if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ defn = Ffunction (Fcons (defn, Qnil)); @@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */) varlist = XCDR (varlist); } - UNGCPRO; - val = Fprogn (Fcdr (args)); - return unbind_to (count, val); } @@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) + ? Qt : if_prop); else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) @@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, /* The caller should GCPRO all the elements of ARGS. */ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, - doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */) + doc: /* Non-nil if OBJECT is a function. */) (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) @@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs, xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else val = Qnil; - + /* Bind the argument. */ if (!NILP (lexenv) && SYMBOLP (next)) /* Lexically bind NEXT by adding it to the lexenv alist. */ @@ -3501,7 +3499,6 @@ context where binding is lexical by default. */) } - DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. */) diff --git a/src/lisp.h b/src/lisp.h index bd70dcebbdb..580dbd11013 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR; #define COMPILED_STACK_DEPTH 3 #define COMPILED_DOC_STRING 4 #define COMPILED_INTERACTIVE 5 -#define COMPILED_PUSH_ARGS 6 /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE @@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int); /* Defined in bytecode.c */ extern Lisp_Object Qbytecode; -EXFUN (Fbyte_code, MANY); +EXFUN (Fbyte_code, 3); extern void syms_of_bytecode (void); extern struct byte_stack *byte_stack_list; #ifdef BYTE_MARK_STACK diff --git a/src/lread.c b/src/lread.c index 24183532527..6a24569f552 100644 --- a/src/lread.c +++ b/src/lread.c @@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) } beg_end_state = NOMINAL; int in_file_vars = 0; -#define UPDATE_BEG_END_STATE(ch) \ - if (beg_end_state == NOMINAL) \ - beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ - else if (beg_end_state == AFTER_FIRST_DASH) \ - beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ - else if (beg_end_state == AFTER_ASTERIX) \ - { \ - if (ch == '-') \ - in_file_vars = !in_file_vars; \ - beg_end_state = NOMINAL; \ +#define UPDATE_BEG_END_STATE(ch) \ + if (beg_end_state == NOMINAL) \ + beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ + else if (beg_end_state == AFTER_FIRST_DASH) \ + beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ + else if (beg_end_state == AFTER_ASTERIX) \ + { \ + if (ch == '-') \ + in_file_vars = !in_file_vars; \ + beg_end_state = NOMINAL; \ } /* Skip until we get to the file vars, if any. */ @@ -834,7 +834,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) UPDATE_BEG_END_STATE (ch); ch = READCHAR; } - + while (var_end > var && (var_end[-1] == ' ' || var_end[-1] == '\t')) var_end--; @@ -880,7 +880,6 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) return rv; } } - /* Value is a version number of byte compiled code if the file associated with file descriptor FD is a compiled Lisp file that's @@ -1275,7 +1274,6 @@ Return t if the file exists and loads successfully. */) specbind (Qinhibit_file_name_operation, Qnil); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); - specbind (Qload_in_progress, Qt); instream = stream; @@ -1863,11 +1861,9 @@ This function preserves the position of point. */) specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); - specbind (Qlexical_binding, Qnil); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - if (lisp_file_lexically_bound_p (buf)) - Fset (Qlexical_binding, Qt); + specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -3336,7 +3332,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) for (i = 0; i < size; i++) { item = Fcar (tem); - /* If `load-force-doc-strings' is t when reading a lazily-loaded bytecode object, the docstring containing the bytecode and constants values must be treated as unibyte and passed to @@ -3394,7 +3389,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) tem = Fcdr (tem); free_cons (otem); } - return vector; } @@ -4024,7 +4018,6 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd, staticpro (address); } - /* Similar but define a variable whose value is the Lisp Object stored at a particular offset in the current kboard object. */ @@ -4470,7 +4463,7 @@ to load. See also `load-dangerous-libraries'. */); doc: /* If non-nil, use lexical binding when evaluating code. This only applies to code evaluated by `eval-buffer' and `eval-region'. This variable is automatically set from the file variables of an interpreted - lisp file read using `load'. */); + Lisp file read using `load'. */); Fmake_variable_buffer_local (Qlexical_binding); DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, diff --git a/src/window.c b/src/window.c index 4bd533c22ac..7e40cdff42b 100644 --- a/src/window.c +++ b/src/window.c @@ -3649,6 +3649,7 @@ displaying that buffer. */) return Qnil; } + void temp_output_buffer_show (register Lisp_Object buf) { -- cgit v1.2.1