Mercurial > hg > xemacs-beta
diff src/eval.c @ 195:a2f645c6b9f8 r20-3b24
Import from CVS: tag r20-3b24
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:59:05 +0200 |
parents | b405438285a2 |
children | 850242ba4a81 |
line wrap: on
line diff
--- a/src/eval.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/eval.c Mon Aug 13 09:59:05 2007 +0200 @@ -771,7 +771,7 @@ Lisp_Object args_left; struct gcpro gcpro1; - if (NILP (args)) + if (! CONSP (args)) return Qnil; args_left = args; @@ -779,10 +779,10 @@ do { - val = Feval (Fcar (args_left)); - args_left = Fcdr (args_left); + val = Feval (XCAR (args_left)); + args_left = XCDR (args_left); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -997,21 +997,33 @@ if (NILP (args)) return Qnil; - val = Flength (args); - if (XINT (val) & 1) /* Odd number of arguments? */ - Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, val)); + { + REGISTER int i; + for (i = 0, val = args ; CONSP (val); val = XCDR (val)) + { + i++; + /* + * uncomment the QUIT if there is some way a circular + * arglist can get in here. I think Feval or Fapply would + * spin first and the list would never get here. + */ + /* QUIT; */ + } + if (i & 1) /* Odd number of arguments? */ + Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i))); + } args_left = args; GCPRO1 (args); do { - val = Feval (Fcar (Fcdr (args_left))); - sym = Fcar (args_left); + val = Feval (XCAR (XCDR (args_left))); + sym = XCAR (args_left); Fset (sym, val); - args_left = Fcdr (Fcdr (args_left)); + args_left = XCDR (XCDR (args_left)); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -2853,6 +2865,46 @@ return Qnil; } +#define inline_funcall_subr(rv, subr, av) \ + do { \ + switch (subr->max_args) { \ + case 0: rv = (subr_function(subr))(); \ + break; \ + case 1: rv = (subr_function(subr))(av[0]); \ + break; \ + case 2: rv = (subr_function(subr))(av[0], av[1]); \ + break; \ + case 3: rv = (subr_function(subr))(av[0], av[1], av[2]); \ + break; \ + case 4: rv = (subr_function(subr))(av[0], av[1], av[2], av[3]); \ + break; \ + case 5: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4]); \ + break; \ + case 6: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5]); \ + break; \ + case 7: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6]); \ + break; \ + case 8: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7]); \ + break; \ + case 9: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8]); \ + break; \ + case 10: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9]); \ + break; \ + case 11: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9], \ + av[10]); \ + break; \ + case 12: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9], \ + av[10], av[11]); \ + break; \ + } \ + } while (0) DEFUN ("eval", Feval, 1, 1, 0, /* Evaluate FORM and return its value. @@ -2923,9 +2975,29 @@ error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - original_fun = Fcar (form); - original_args = Fcdr (form); - nargs = XINT (Flength (original_args)); + /* + * At this point we know that `form' is a Lisp_Cons so we can safely + * use XCAR and XCDR. + */ + original_fun = XCAR (form); + original_args = XCDR (form); + + /* + * Formerly we used a call to Flength here, but that is slow and + * wasteful due to type checking, stack push/pop and initialization. + * We know we're dealing with a cons, so open code it for speed. + * + * We call QUIT in the loop so that a circular arg list won't lock + * up the editor. + */ + for (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val)) + { + nargs++; + QUIT; + } + if (! NILP (val)) + signal_simple_error ("Argument list must be nil-terminated", + original_args); #ifdef EMACS_BTL backtrace.id_number = 0; @@ -2982,10 +3054,10 @@ gcpro3.nvars = 0; argnum = 0; - while (!NILP (args_left)) + while (CONSP (args_left)) { - vals[argnum++] = Feval (Fcar (args_left)); - args_left = Fcdr (args_left); + vals[argnum++] = Feval (XCAR (args_left)); + args_left = XCDR (args_left); gcpro3.nvars = argnum; } @@ -3016,21 +3088,23 @@ gcpro3.var = argvals; gcpro3.nvars = 0; - for (i = 0; i < nargs; args_left = Fcdr (args_left)) + for (i = 0; i < nargs; args_left = XCDR (args_left)) { - argvals[i] = Feval (Fcar (args_left)); + argvals[i] = Feval (XCAR (args_left)); gcpro3.nvars = ++i; } UNGCPRO; - for (i = nargs; i < max_args; i++) + /* i == nargs at this point */ + for (; i < max_args; i++) argvals[i] = Qnil; backtrace.args = argvals; backtrace.nargs = nargs; - val = funcall_subr (subr, argvals); + /* val = funcall_subr (subr, argvals); */ + inline_funcall_subr(val, subr, argvals); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3041,7 +3115,7 @@ if (!CONSP (fun)) goto invalid_function; - funcar = Fcar (fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) goto invalid_function; if (EQ (funcar, Qautoload)) @@ -3050,7 +3124,7 @@ goto retry; } if (EQ (funcar, Qmacro)) - val = Feval (apply1 (Fcdr (fun), original_args)); + val = Feval (apply1 (XCDR (fun), original_args)); else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, nargs, original_args); else @@ -3155,10 +3229,12 @@ for (i = nargs; i < max_args; i++) argvals[i] = Qnil; - val = funcall_subr (subr, argvals); + /* val = funcall_subr (subr, argvals); */ + inline_funcall_subr(val, subr, argvals); } else - val = funcall_subr (subr, args + 1); + /* val = funcall_subr (subr, args + 1); */ + inline_funcall_subr(val, subr, (&args[1])); } else if (COMPILED_FUNCTIONP (fun)) val = funcall_lambda (fun, nargs, args + 1); @@ -3169,7 +3245,8 @@ } else { - Lisp_Object funcar = Fcar (fun); + /* `fun' is a Lisp_Cons so XCAR is safe */ + Lisp_Object funcar = XCAR (fun); if (!SYMBOLP (funcar)) goto invalid_function; @@ -3339,13 +3416,27 @@ { /* This function can GC */ Lisp_Object fun = args[0]; - Lisp_Object spread_arg = args [nargs - 1]; + Lisp_Object spread_arg = args [nargs - 1], p; int numargs; int funcall_nargs; CHECK_LIST (spread_arg); - numargs = XINT (Flength (spread_arg)); + /* + * Formerly we used a call to Flength here, but that is slow and + * wasteful due to type checking, stack push/pop and initialization. + * We know we're dealing with a cons, so open code it for speed. + * + * We call QUIT in the loop so that a circular arg list won't lock + * up the editor. + */ + for (numargs = 0, p = spread_arg ; CONSP (p) ; p = XCDR (p)) + { + numargs++; + QUIT; + } + if (! NILP (p)) + signal_simple_error ("Argument list must be nil-terminated", spread_arg); if (numargs == 0) /* (apply foo 0 1 '()) */ @@ -3482,7 +3573,11 @@ for (i = 0; i < numargs;) { - tem = Fcar (unevalled_args), unevalled_args = Fcdr (unevalled_args); + /* + * unevalled_args is always a normal list, or Feval would have + * rejected it, so use XCAR and XCDR. + */ + tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args); tem = Feval (tem); arg_vector[i++] = tem; gcpro1.nvars = i; @@ -3519,16 +3614,16 @@ int optional = 0, rest = 0; if (CONSP (fun)) - syms_left = Fcar (Fcdr (fun)); + syms_left = Fcar (XCDR (fun)); else if (COMPILED_FUNCTIONP (fun)) syms_left = XCOMPILED_FUNCTION (fun)->arglist; else abort (); i = 0; - for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) + for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { QUIT; - next = Fcar (syms_left); + next = XCAR (syms_left); if (!SYMBOLP (next)) signal_error (Qinvalid_function, list1 (fun)); if (EQ (next, Qand_rest)) @@ -3557,7 +3652,7 @@ list2 (fun, make_int (nargs))); if (CONSP (fun)) - val = Fprogn (Fcdr (Fcdr (fun))); + val = Fprogn (Fcdr (XCDR (fun))); else { struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);