Mercurial > hg > xemacs-beta
diff src/eval.c @ 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:55:28 +0200 |
parents | bfd6434d15b3 |
children | b405438285a2 |
line wrap: on
line diff
--- a/src/eval.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/eval.c Mon Aug 13 09:55:28 2007 +0200 @@ -69,7 +69,7 @@ current position in the GCPRO stack. All of these are restored by Fthrow(). */ - + struct catchtag *catchlist; Lisp_Object Qautoload, Qmacro, Qexit; @@ -181,7 +181,7 @@ #endif /* Nonzero means we are trying to enter the debugger. - This is to prevent recursive attempts. + This is to prevent recursive attempts. Cleared by the debugger calling Fbacktrace */ static int entering_debugger; @@ -258,7 +258,7 @@ ? "#<special-form " : "#<subr "), printcharfun); - + write_c_string (subr_name (subr), printcharfun); write_c_string (((subr->prompt) ? " (interactive)>" : ">"), printcharfun); @@ -303,7 +303,7 @@ && internal_equal (b1->bytecodes, b2->bytecodes, depth + 1) && internal_equal (b1->constants, b2->constants, depth + 1) && internal_equal (b1->arglist, b2->arglist, depth + 1) - && internal_equal (b1->doc_and_interactive, + && internal_equal (b1->doc_and_interactive, b2->doc_and_interactive, depth + 1)); } @@ -399,12 +399,12 @@ debug_on_next_call = 0; speccount = specpdl_depth_counter; - record_unwind_protect (restore_entering_debugger, + record_unwind_protect (restore_entering_debugger, (entering_debugger ? Qt : Qnil)); entering_debugger = 1; val = internal_catch (Qdebugger, call_debugger_259, arg, &threw); - return unbind_to (speccount, ((threw) + return unbind_to (speccount, ((threw) ? Qunbound /* Not returning a value */ : val)); } @@ -573,7 +573,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + internal_with_output_to_temp_buffer ("*Backtrace*", backtrace_259, Qnil, @@ -581,7 +581,7 @@ unbind_to (speccount, Qnil); *stack_trace_displayed = 1; } - + if (!entering_debugger && !*debugger_entered && !signal_vars_only && (EQ (sig, Qquit) ? debug_on_quit @@ -593,7 +593,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); *debugger_entered = 1; } @@ -605,7 +605,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + internal_with_output_to_temp_buffer ("*Backtrace*", backtrace_259, Qnil, @@ -624,7 +624,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); *debugger_entered = 1; } @@ -916,7 +916,7 @@ /* Make space to hold the values to give the bound variables */ elt = Flength (varlist); - temps = (Lisp_Object *) alloca (XINT (elt) * sizeof (Lisp_Object)); + temps = alloca_array (Lisp_Object, XINT (elt)); /* Compute the values and store them in `temps' */ @@ -978,8 +978,6 @@ return Qnil; } -Lisp_Object Qsetq; - DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /* (setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). @@ -1018,7 +1016,7 @@ UNGCPRO; return val; } - + DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /* Return the argument, without evaluating it. `(quote x)' yields `x'. */ @@ -1026,7 +1024,7 @@ { return Fcar (args); } - + DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be compiled. @@ -1204,7 +1202,7 @@ (variable)) { Lisp_Object documentation; - + documentation = Fget (variable, Qvariable_documentation, Qnil); if (INTP (documentation) && XINT (documentation) < 0) return Qt; @@ -1218,7 +1216,7 @@ && XINT (XCDR (documentation)) < 0) return Qt; return Qnil; -} +} DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* Return result of expanding macros at top level of FORM. @@ -1326,7 +1324,7 @@ This is how catches are done from within C code. */ Lisp_Object -internal_catch (Lisp_Object tag, +internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object arg), Lisp_Object arg, int *threw) @@ -1397,7 +1395,7 @@ */ /* Save the value somewhere it will be GC'ed. - (Can't overwrite tag slot because an unwind-protect may + (Can't overwrite tag slot because an unwind-protect may want to throw to this same tag, which isn't yet invalid.) */ c->val = val; @@ -1431,7 +1429,7 @@ throw_level = 0; LONGJMP (c->jmp, 1); -} +} static DOESNT_RETURN throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, @@ -1455,9 +1453,9 @@ established at the same time, in initial_command_loop/ top_level_1. - #### Fix this horrifitude! + #### Fix this horrifitude! */ - + while (1) { REGISTER struct catchtag *c; @@ -1703,7 +1701,7 @@ if (!NILP (h.var)) specbind (h.var, c.val); val = Fprogn (Fcdr (h.chosen_clause)); - + /* Note that this just undoes the binding of h.var; whoever longjumped to us unwound the stack to c.pdlcount before throwing. */ @@ -1726,7 +1724,7 @@ condition-case except that it takes three arguments rather than a single list of arguments. */ Lisp_Object -Fcondition_case_3 (Lisp_Object bodyform, +Fcondition_case_3 (Lisp_Object bodyform, Lisp_Object var, Lisp_Object handlers) { /* This function can GC */ @@ -1738,13 +1736,13 @@ { Lisp_Object tem; tem = Fcar (val); - if ((!NILP (tem)) + if ((!NILP (tem)) && (!CONSP (tem) || (!SYMBOLP (XCAR (tem)) && !CONSP (XCAR (tem))))) signal_simple_error ("Invalid condition handler", tem); } - return condition_case_1 (handlers, + return condition_case_1 (handlers, Feval, bodyform, run_condition_case_handlers, var); @@ -1790,7 +1788,7 @@ return Fcondition_case_3 (Fcar (Fcdr (args)), Fcar (args), Fcdr (Fcdr (args))); -} +} DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /* Regain control when an error is signalled, without popping the stack. @@ -1963,7 +1961,7 @@ /* It's a condition-case handler */ - /* t is used by handlers for all conditions, set up by C code. + /* t is used by handlers for all conditions, set up by C code. * debugger is not called even if debug_on_error */ else if (EQ (handler_data, Qt)) { @@ -2024,7 +2022,7 @@ there is no 'top-level catch. (That's why the "bomb-out" hack was added.) - #### Fix this horrifitude! + #### Fix this horrifitude! */ signal_call_debugger (conditions, sig, data, Qnil, 0, &stack_trace_displayed, @@ -2156,7 +2154,7 @@ } else no_error = Qnil; - + va_start (vargs, nargs); for (i = 0; i < nargs; i++) args[i] = va_arg (vargs, Lisp_Object); @@ -2165,7 +2163,7 @@ /* If error-checking is not disabled, just call the function. It's important not to override disabled error-checking with enabled error-checking. */ - + if (ERRB_EQ (errb, ERROR_ME)) return primitive_funcall (fun, nargs, args); @@ -2366,7 +2364,7 @@ return maybe_signal_continuable_error (Qerror, list2 (build_translated_string (reason), frob), class, errb); -} +} /****************** Error functions class 4 ******************/ @@ -2506,7 +2504,7 @@ /* This function can GC */ if (EQ (Vquit_flag, Qcritical)) debug_on_quit |= 2; /* set critical bit. */ - Vquit_flag = Qnil; + Vquit_flag = Qnil; /* note that this is continuable. */ Fsignal (Qquit, Qnil); } @@ -2676,7 +2674,7 @@ /* If this isn't a byte-compiled function, then we may now be looking at several frames for special forms. Skip past them. */ - while (btp && + while (btp && btp->nargs == UNEVALLED) btp = btp->next; @@ -2746,7 +2744,7 @@ file = Fsymbol_name (Fintern (file, Qnil)); } - return Ffset (function, + return Ffset (function, Fpurecopy (Fcons (Qautoload, list4 (file, docstring, interactive, @@ -2778,7 +2776,7 @@ } void -do_autoload (Lisp_Object fundef, +do_autoload (Lisp_Object fundef, Lisp_Object funname) { /* This function can GC */ @@ -2840,9 +2838,9 @@ /* eval, funcall, apply */ /**********************************************************************/ -static Lisp_Object funcall_lambda (Lisp_Object fun, +static Lisp_Object funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object args[]); -static Lisp_Object apply_lambda (Lisp_Object fun, +static Lisp_Object apply_lambda (Lisp_Object fun, int nargs, Lisp_Object args); static Lisp_Object funcall_subr (struct Lisp_Subr *sub, Lisp_Object args[]); @@ -2885,7 +2883,7 @@ level = XCAR (XCDR (this_warning)); messij = XCAR (XCDR (XCDR (this_warning))); free_list (this_warning); - + if (NILP (Vpending_warnings)) Vpending_warnings_tail = Qnil; /* perhaps not strictly necessary, but safer */ @@ -2961,7 +2959,7 @@ if (nargs < subr->min_args || (max_args >= 0 && max_args < nargs)) { - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); } @@ -2978,7 +2976,7 @@ REGISTER int argnum; struct gcpro gcpro1, gcpro2, gcpro3; - vals = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); + vals = alloca_array (Lisp_Object, nargs); GCPRO3 (args_left, fun, vals[0]); gcpro3.nvars = 0; @@ -3023,9 +3021,9 @@ argvals[i] = Feval (Fcar (args_left)); gcpro3.nvars = ++i; } - + UNGCPRO; - + for (i = nargs; i < max_args; i++) argvals[i] = Qnil; @@ -3137,7 +3135,7 @@ if (nargs < subr->min_args || (max_args >= 0 && max_args < nargs)) { - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); } @@ -3346,7 +3344,7 @@ int funcall_nargs; CHECK_LIST (spread_arg); - + numargs = XINT (Flength (spread_arg)); if (numargs == 0) @@ -3390,8 +3388,7 @@ } { REGISTER int i; - REGISTER Lisp_Object *funcall_args - = (Lisp_Object *) alloca (funcall_nargs * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, funcall_nargs); struct gcpro gcpro1; GCPRO1 (*funcall_args); @@ -3401,7 +3398,7 @@ memcpy (funcall_args, args, (nargs - 1) * 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. */ - for (i = nargs - 1; + for (i = nargs - 1; !NILP (spread_arg); /* i < 1 + numargs */ i++, spread_arg = XCDR (spread_arg)) { @@ -3478,8 +3475,7 @@ struct gcpro gcpro1, gcpro2, gcpro3; REGISTER int i; REGISTER Lisp_Object tem; - REGISTER Lisp_Object *arg_vector - = (Lisp_Object *) alloca (numargs * sizeof (Lisp_Object)); + REGISTER Lisp_Object *arg_vector = alloca_array (Lisp_Object, numargs); GCPRO3 (*arg_vector, unevalled_args, fun); gcpro1.nvars = 0; @@ -3550,14 +3546,14 @@ specbind (next, tem); } else if (!optional) - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); else specbind (next, Qnil); } if (i < nargs) - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); if (CONSP (fun)) @@ -3631,7 +3627,7 @@ return Qnil; } - + DEFUN ("run-hook-with-args", Frun_hook_with_args, 1, MANY, 0, /* Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil @@ -3825,8 +3821,7 @@ struct gcpro gcpro1; int i; va_list vargs; - Lisp_Object *funcall_args = - (Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); va_start (vargs, nargs); funcall_args[0] = hook_var; @@ -3848,8 +3843,7 @@ struct gcpro gcpro1; int i; va_list vargs; - Lisp_Object *funcall_args = - (Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); va_start (vargs, nargs); funcall_args[0] = hook_var; @@ -3911,7 +3905,7 @@ { /* This function can GC */ struct gcpro gcpro1; - Lisp_Object args[2]; + Lisp_Object args[2]; args[0] = fn; args[1] = arg0; GCPRO1 (args[0]); @@ -3974,7 +3968,7 @@ /* Call function fn with arguments arg0, arg1, arg2, arg3, arg4 */ Lisp_Object call5 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4) { /* This function can GC */ @@ -3993,7 +3987,7 @@ Lisp_Object call6 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5) { /* This function can GC */ @@ -4013,7 +4007,7 @@ Lisp_Object call7 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) { @@ -4035,7 +4029,7 @@ Lisp_Object call8 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) { @@ -4237,7 +4231,7 @@ return value. */ -/* #### This stuff needs to catch throws as well. We need to +/* #### This stuff needs to catch throws as well. We need to improve internal_catch() so it can take a "catch anything" argument similar to Qt or Qerror for condition_case_1(). */ @@ -4247,7 +4241,7 @@ if (!NILP (errordata)) { Lisp_Object args[2]; - + if (!NILP (arg)) { char *str = (char *) get_opaque_ptr (arg); @@ -4330,7 +4324,7 @@ if (OPAQUEP (opaque)) free_opaque_ptr (opaque); UNGCPRO; - + /* gc_currently_forbidden = 0; */ return unbind_to (speccount, tem); } @@ -4394,7 +4388,7 @@ if (!allow_quit) specbind (Qinhibit_quit, Qt); - cons = noseeum_cons (hook_symbol, + cons = noseeum_cons (hook_symbol, warning_string ? make_opaque_ptr (warning_string) : Qnil); GCPRO1 (cons); @@ -4499,7 +4493,7 @@ free_opaque_ptr (opaque); free_cons (XCONS (cons)); UNGCPRO; - + /* gc_currently_forbidden = 0; */ return unbind_to (speccount, tem); } @@ -4566,8 +4560,7 @@ specpdl_size *= 2; if (specpdl_size > max_specpdl_size) specpdl_size = max_specpdl_size; - specpdl = ((struct specbinding *) - xrealloc (specpdl, specpdl_size * sizeof (struct specbinding))); + XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size); specpdl_ptr = specpdl + specpdl_depth_counter; } @@ -4676,7 +4669,7 @@ specpdl_ptr->old_value = Fcurrent_buffer (); specpdl_ptr->func = specbind_unwind_wasnt_local; } - + specpdl_ptr->symbol = symbol; specpdl_ptr++; specpdl_depth_counter++; @@ -4792,7 +4785,7 @@ } } return Fset (symbol, newval); -} +} #endif /* 0 */ @@ -4855,7 +4848,7 @@ and defaults to the value of `standard-output'. Optional second arg DETAILED means show places where currently active variable bindings, catches, condition-cases, and unwind-protects were made as well as -function calls. +function calls. */ (stream, detailed)) { @@ -4897,7 +4890,7 @@ && speccount > catchpdl) /* This is a condition-case catchpoint */ catchpdl = catchpdl + 1; - + backtrace_specials (speccount, catchpdl, stream); speccount = catches->pdlcount; @@ -5270,8 +5263,7 @@ specpdl_size = 50; specpdl_depth_counter = 0; - specpdl = (struct specbinding *) - xmalloc (specpdl_size * sizeof (struct specbinding)); + specpdl = xnew_array (struct specbinding, specpdl_size); /* XEmacs change: increase these values. */ max_specpdl_size = 3000; max_lisp_eval_depth = 500;