X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Feval.c;h=4ac9537a11d0f4d900d7d0b0bb2f02149d873a67;hb=5d1c137b9eb678416231a16e78550da265e650ab;hp=d34ba2e77c925f8c77cac27ea204b8c5710287ed;hpb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;p=chise%2Fxemacs-chise.git.1 diff --git a/src/eval.c b/src/eval.c index d34ba2e..4ac9537 100644 --- a/src/eval.c +++ b/src/eval.c @@ -67,7 +67,7 @@ struct backtrace *backtrace_list; #define AV_8(av) AV_7(av), av[7] #define PRIMITIVE_FUNCALL_1(fn, av, ac) \ -(((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av))) + (((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av))) /* If subrs take more than 8 arguments, more cases need to be added to this switch. (But wait - don't do it - if you really need @@ -163,13 +163,13 @@ struct specbinding *specpdl_ptr; int specpdl_depth_counter; /* Maximum size allowed for specpdl allocation */ -int max_specpdl_size; +Fixnum max_specpdl_size; /* Depth in Lisp evaluations and function calls. */ static int lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ -int max_lisp_eval_depth; +Fixnum max_lisp_eval_depth; /* Nonzero means enter debugger before next function call */ static int debug_on_next_call; @@ -727,7 +727,7 @@ BODY can be zero or more expressions. If BODY is nil, return nil. } DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /* -(cond CLAUSES...): try each clause until one succeeds. +\(cond CLAUSES...): try each clause until one succeeds. Each clause looks like (CONDITION BODY...). CONDITION is evaluated and, if the value is non-nil, this clause succeeds: then the expressions in BODY are evaluated and the last one's @@ -1236,6 +1236,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. if (EQ (tem, Qt) || EQ (tem, Qmacro)) { /* Yes, load it and try again. */ + /* do_autoload GCPROs both arguments */ do_autoload (def, sym); continue; } @@ -1407,7 +1408,7 @@ throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, #ifdef DEFEND_AGAINST_THROW_RECURSION /* die if we recurse more than is reasonable */ if (++throw_level > 20) - abort(); + ABORT(); #endif /* If bomb_out_p is t, this is being called from Fsignal as a @@ -1471,12 +1472,12 @@ throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, */ DEFUN ("throw", Fthrow, 2, 2, 0, /* -\(throw TAG VALUE): throw to the catch for TAG and return VALUE from it. +Throw to the catch for TAG and return VALUE from it. Both TAG and VALUE are evalled. */ - (tag, val)) + (tag, value)) { - throw_or_bomb_out (tag, val, 0, Qnil, Qnil); /* Doesn't return */ + throw_or_bomb_out (tag, value, 0, Qnil, Qnil); /* Doesn't return */ return Qnil; } @@ -1876,13 +1877,13 @@ signal_1 (Lisp_Object sig, Lisp_Object data) /* let's not use stderr_out() here, because that does a bunch of things that might not be safe yet. */ fprintf (stderr, "Error before initialization is complete!\n"); - abort (); + ABORT (); } if (gc_in_progress || in_display) /* This is one of many reasons why you can't run lisp code from redisplay. There is no sensible way to handle errors there. */ - abort (); + ABORT (); conditions = Fget (sig, Qerror_conditions, Qnil); @@ -2047,7 +2048,7 @@ user invokes the "return from signal" option. warn_when_safe_lispobj (Vcurrent_warning_class, Qwarning, Fcons (error_symbol, data)); Fthrow (Qunbound_suspended_errors_tag, Qnil); - abort (); /* Better not get here! */ + ABORT (); /* Better not get here! */ } RETURN_UNGCPRO (signal_1 (error_symbol, data)); } @@ -2932,7 +2933,7 @@ Optional second arg RECORD-FLAG is as in `call-interactively'. The argument KEYS specifies the value to use instead of (this-command-keys) when reading the arguments. */ - (cmd, record, keys)) + (cmd, record_flag, keys)) { /* This function can GC */ Lisp_Object prefixarg; @@ -2952,7 +2953,10 @@ when reading the arguments. { final = indirect_function (cmd, 1); if (CONSP (final) && EQ (Fcar (final), Qautoload)) - do_autoload (final, cmd); + { + /* do_autoload GCPROs both arguments */ + do_autoload (final, cmd); + } else break; } @@ -2967,7 +2971,7 @@ when reading the arguments. backtrace.debug_on_exit = 0; PUSH_BACKTRACE (backtrace); - final = Fcall_interactively (cmd, record, keys); + final = Fcall_interactively (cmd, record_flag, keys); POP_BACKTRACE (backtrace); return final; @@ -3066,24 +3070,24 @@ and input is currently coming from the keyboard (not in keyboard macro). /************************************************************************/ DEFUN ("autoload", Fautoload, 2, 5, 0, /* -Define FUNCTION to autoload from FILE. -FUNCTION is a symbol; FILE is a file name string to pass to `load'. -Third arg DOCSTRING is documentation for the function. -Fourth arg INTERACTIVE if non-nil says function can be called interactively. -Fifth arg TYPE indicates the type of the object: +Define FUNCTION to autoload from FILENAME. +FUNCTION is a symbol; FILENAME is a file name string to pass to `load'. +The remaining optional arguments provide additional info about the +real definition. +DOCSTRING is documentation for FUNCTION. +INTERACTIVE, if non-nil, says FUNCTION can be called interactively. +TYPE indicates the type of the object: nil or omitted says FUNCTION is a function, `keymap' says FUNCTION is really a keymap, and `macro' or t says FUNCTION is really a macro. -Third through fifth args give info about the real definition. -They default to nil. -If FUNCTION is already defined other than as an autoload, -this does nothing and returns nil. +If FUNCTION already has a non-void function definition that is not an +autoload object, this function does nothing and returns nil. */ - (function, file, docstring, interactive, type)) + (function, filename, docstring, interactive, type)) { /* This function can GC */ CHECK_SYMBOL (function); - CHECK_STRING (file); + CHECK_STRING (filename); /* If function is defined and not as an autoload, don't override */ { @@ -3095,10 +3099,10 @@ this does nothing and returns nil. if (purify_flag) { /* Attempt to avoid consing identical (string=) pure strings. */ - file = Fsymbol_name (Fintern (file, Qnil)); + filename = Fsymbol_name (Fintern (filename, Qnil)); } - return Ffset (function, Fcons (Qautoload, list4 (file, + return Ffset (function, Fcons (Qautoload, list4 (filename, docstring, interactive, type))); @@ -3135,10 +3139,10 @@ do_autoload (Lisp_Object fundef, /* This function can GC */ int speccount = specpdl_depth(); Lisp_Object fun = funname; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3; CHECK_SYMBOL (funname); - GCPRO2 (fun, funname); + GCPRO3 (fun, funname, fundef); /* Value saved here is to be restored into Vautoload_queue */ record_unwind_protect (un_autoload, Vautoload_queue); @@ -3401,6 +3405,7 @@ Evaluate FORM and return its value. if (EQ (funcar, Qautoload)) { + /* do_autoload GCPROs both arguments */ do_autoload (fun, original_fun); goto retry; } @@ -3458,6 +3463,7 @@ Evaluate FORM and return its value. } +/* #### Why is Feval so anal about GCPRO, Ffuncall so cavalier? */ DEFUN ("funcall", Ffuncall, 1, MANY, 0, /* Call first argument as a function, passing the remaining arguments to it. Thus, (funcall 'cons 'x 'y) returns (x . y). @@ -3525,7 +3531,10 @@ Thus, (funcall 'cons 'x 'y) returns (x . y). if (fun_nargs == max_args) /* Optimize for the common case */ { funcall_subr: - FUNCALL_SUBR (val, subr, fun_args, max_args); + { + /* The "extra" braces placate GCC 2.95.4. */ + FUNCALL_SUBR (val, subr, fun_args, max_args); + } } else if (fun_nargs < subr->min_args) { @@ -3572,6 +3581,7 @@ Thus, (funcall 'cons 'x 'y) returns (x . y). } else if (EQ (funcar, Qautoload)) { + /* do_autoload GCPROs both arguments */ do_autoload (fun, args[0]); goto retry; } @@ -3650,11 +3660,8 @@ function_argcount (Lisp_Object function, int function_min_args_p) } else if (EQ (funcar, Qautoload)) { - struct gcpro gcpro1; - - GCPRO1 (function); + /* do_autoload GCPROs both arguments */ do_autoload (function, orig_function); - UNGCPRO; function = orig_function; goto retry; } @@ -3897,7 +3904,7 @@ called to run the hook. If the value is a function, it is called with the given arguments and its return value is returned. If it is a list of functions, those functions are called, in order, with the given arguments ARGS. -It is best not to depend on the value return by `run-hook-with-args', +It is best not to depend on the value returned by `run-hook-with-args', as that may change. To make a hook variable buffer-local, use `make-local-hook', @@ -4788,9 +4795,9 @@ call2_trapping_errors (const char *warning_string, Lisp_Object function, #define min_max_specpdl_size 400 void -grow_specpdl (size_t reserved) +grow_specpdl (EMACS_INT reserved) { - size_t size_needed = specpdl_depth() + reserved; + EMACS_INT size_needed = specpdl_depth() + reserved; if (size_needed >= max_specpdl_size) { if (max_specpdl_size < min_max_specpdl_size) @@ -4926,6 +4933,9 @@ specbind_magic (Lisp_Object symbol, Lisp_Object value) Fset (symbol, value); } +/* Note: As long as the unwind-protect exists, its arg is automatically + GCPRO'd. */ + void record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg), Lisp_Object arg) @@ -5103,10 +5113,10 @@ backtrace_specials (int speccount, int speclimit, Lisp_Object stream) DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* Print a trace of Lisp function calls currently active. Optional arg STREAM specifies the output stream to send the backtrace to, -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. +and defaults to the value of `standard-output'. +Optional second arg DETAILED non-nil means show places where currently +active variable bindings, catches, condition-cases, and +unwind-protects, as well as function calls, were made. */ (stream, detailed)) { @@ -5231,8 +5241,8 @@ function calls. } -DEFUN ("backtrace-frame", Fbacktrace_frame, 1, 1, "", /* -Return the function and arguments N frames up from current execution point. +DEFUN ("backtrace-frame", Fbacktrace_frame, 1, 1, 0, /* +Return the function and arguments NFRAMES up from current execution point. If that frame has not evaluated the arguments yet (or is a special form), the value is (nil FUNCTION ARG-FORMS...). If that frame has evaluated its arguments and called its function already, @@ -5240,7 +5250,7 @@ the value is (t FUNCTION ARG-VALUES...). A &rest arg is represented as the tail of the list ARG-VALUES. FUNCTION is whatever was supplied as car of evaluated list, or a lambda expression for macro calls. -If N is more than the number of frames, the value is nil. +If NFRAMES is more than the number of frames, the value is nil. */ (nframes)) { @@ -5529,7 +5539,7 @@ If due to `eval' entry, one arg, t. staticpro (&Vpending_warnings); Vpending_warnings = Qnil; - pdump_wire (&Vpending_warnings_tail); + dump_add_root_object (&Vpending_warnings_tail); Vpending_warnings_tail = Qnil; staticpro (&Vautoload_queue);