Mercurial > emacs
changeset 323:9c2a1e7bd9f1
*** empty log message ***
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Fri, 12 Jul 1991 04:00:11 +0000 |
parents | 820dc6c9612a |
children | 133f1a8cc567 |
files | src/eval.c |
diffstat | 1 files changed, 55 insertions(+), 32 deletions(-) [+] |
line wrap: on
line diff
--- a/src/eval.c Thu Jul 11 23:17:40 1991 +0000 +++ b/src/eval.c Fri Jul 12 04:00:11 1991 +0000 @@ -454,13 +454,12 @@ (if interpreted) or the frame of byte-code (if called from compiled function). */ btp = backtrace_list; - if (! XTYPE (*btp->function) == Lisp_Compiled) + if (XTYPE (*btp->function) != Lisp_Compiled) btp = btp->next; - for (; - btp && (btp->nargs == UNEVALLED - || EQ (*btp->function, Qbytecode)); - btp = btp->next) - {} + while (btp + && (btp->nargs == UNEVALLED || EQ (*btp->function, Qbytecode))) + btp = btp->next; + /* btp now points at the frame of the innermost function that DOES eval its args. If it is a built-in function (such as load or eval-region) @@ -1445,12 +1444,12 @@ args_left = Fcdr (args_left); gcpro3.nvars = argnum; } - UNGCPRO; backtrace.args = vals; backtrace.nargs = XINT (numargs); val = (*XSUBR (fun)->function) (XINT (numargs), vals); + UNGCPRO; goto done; } @@ -1552,6 +1551,7 @@ register Lisp_Object spread_arg; register Lisp_Object *funcall_args; Lisp_Object fun; + struct gcpro gcpro1; fun = args [0]; funcall_args = 0; @@ -1568,7 +1568,7 @@ return Ffuncall (nargs, args); } - numargs = nargs - 2 + numargs; + numargs += nargs - 2; while (XTYPE (fun) == Lisp_Symbol) { @@ -1595,14 +1595,21 @@ * sizeof (Lisp_Object)); for (i = numargs; i < XSUBR (fun)->max_args;) funcall_args[++i] = Qnil; + GCPRO1 (*funcall_args); + gcpro1.nvars = 1 + XSUBR (fun)->max_args; } } funcall: /* We add 1 to numargs because funcall_args includes the function itself as well as its arguments. */ if (!funcall_args) - funcall_args = (Lisp_Object *) alloca ((1 + numargs) - * sizeof (Lisp_Object)); + { + funcall_args = (Lisp_Object *) alloca ((1 + numargs) + * sizeof (Lisp_Object)); + GCPRO1 (*funcall_args); + gcpro1.nvars = 1 + numargs; + } + bcopy (args, funcall_args, nargs * sizeof (Lisp_Object)); /* Spread the last arg we got. Its first element goes in the slot that it used to occupy, hence this value of I. */ @@ -1612,8 +1619,8 @@ funcall_args [i++] = XCONS (spread_arg)->car; spread_arg = XCONS (spread_arg)->cdr; } - - return Ffuncall (numargs + 1, funcall_args); + + RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args)); } /* Apply fn to arg */ @@ -1621,17 +1628,22 @@ apply1 (fn, arg) Lisp_Object fn, arg; { + struct gcpro gcpro1; + + GCPRO1 (fn); if (NULL (arg)) - return Ffuncall (1, &fn); + RETURN_UNGCPRO (Ffuncall (1, &fn)); + gcpro1.nvars = 2; #ifdef NO_ARG_ARRAY { Lisp_Object args[2]; args[0] = fn; args[1] = arg; - return Fapply (2, args); + gcpro1.var = args; + RETURN_UNGCPRO (Fapply (2, args)); } #else /* not NO_ARG_ARRAY */ - return Fapply (2, &fn); + RETURN_UNGCPRO (Fapply (2, &fn)); #endif /* not NO_ARG_ARRAY */ } @@ -1640,7 +1652,10 @@ call0 (fn) Lisp_Object fn; { - return Ffuncall (1, &fn); + struct gcpro gcpro1; + + GCPRO1 (fn); + RETURN_UNGCPRO (Ffuncall (1, &fn)); } /* Call function fn with argument arg */ @@ -1649,13 +1664,19 @@ call1 (fn, arg) Lisp_Object fn, arg; { + struct gcpro gcpro1; #ifdef NO_ARG_ARRAY - Lisp_Object args[2]; + Lisp_Object args[2]; + args[0] = fn; args[1] = arg; - return Ffuncall (2, args); + GCPRO1 (args[0]); + gcpro1.nvars = 2; + RETURN_UNGCPRO (Ffuncall (2, args)); #else /* not NO_ARG_ARRAY */ - return Ffuncall (2, &fn); + GCPRO1 (fn); + gcpro1.nvars = 2; + RETURN_UNGCPRO (Ffuncall (2, &fn)); #endif /* not NO_ARG_ARRAY */ } @@ -1665,14 +1686,19 @@ call2 (fn, arg, arg1) Lisp_Object fn, arg, arg1; { + struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[3]; args[0] = fn; args[1] = arg; args[2] = arg1; - return Ffuncall (3, args); + GCPRO1 (args[0]); + gcpro1.nvars = 3; + RETURN_UNGCPRO (Ffuncall (3, args)); #else /* not NO_ARG_ARRAY */ - return Ffuncall (3, &fn); + GCPRO1 (fn); + gcpro1.nvars = 3; + RETURN_UNGCPRO (Ffuncall (3, &fn)); #endif /* not NO_ARG_ARRAY */ } @@ -1682,15 +1708,20 @@ call3 (fn, arg, arg1, arg2) Lisp_Object fn, arg, arg1, arg2; { + struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[4]; args[0] = fn; args[1] = arg; args[2] = arg1; args[3] = arg2; - return Ffuncall (4, args); + GCPRO1 (args[0]); + gcpro1.nvars = 4; + RETURN_UNGCPRO (Ffuncall (4, args)); #else /* not NO_ARG_ARRAY */ - return Ffuncall (4, &fn); + GCPRO1 (fn); + gcpro1.nvars = 4; + RETURN_UNGCPRO (Ffuncall (4, &fn)); #endif /* not NO_ARG_ARRAY */ } @@ -1712,15 +1743,7 @@ QUIT; if (consing_since_gc > gc_cons_threshold) - { - struct gcpro gcpro1; - - /* The backtrace protects the arguments for the rest of the function. */ - GCPRO1 (*args); - gcpro1.nvars = nargs; - Fgarbage_collect (); - UNGCPRO; - } + Fgarbage_collect (); if (++lisp_eval_depth > max_lisp_eval_depth) {