xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.

author	ben
date	Tue, 28 May 2002 08:45:36 +0000
parents	e7ee5f8bde58
children	804517e16990

comparison

equal deleted inserted replaced

-:d83885ef293b
+:2b6fa2618f76
 along with XEmacs; see the file COPYING.  If not, write to
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 /* Synched up with: FSF 19.30 (except for Fsignal), Mule 2.0. */
+/* Authorship:
+Based on code from pre-release FSF 19, c. 1991.
+Some work by Richard Mlynarik long ago (c. 1993?) --
+added call-with-condition-handler; synch. up to released FSF 19.7
+for lemacs 19.8.  some signal changes.
+Various work by Ben Wing, 1995-1996:
+added all stuff dealing with trapping errors, suspended-errors, etc.
+added most Fsignal front ends.
+added warning code.
+reworked the Fsignal code and synched the rest up to FSF 19.30.
+Some changes by Martin Buchholz c. 1999?
+e.g. PRIMITIVE_FUNCALL macros.
+New call_trapping_problems code and large comments below
+by Ben Wing, Mar-Apr 2000.
+*/
+/* This file has been Mule-ized. */
+/* What is in this file?
+This file contains the engine for the ELisp interpreter in XEmacs.
+The engine does the actual work of implementing function calls,
+form evaluation, non-local exits (catch, throw, signal,
+condition-case, call-with-condition-handler), unwind-protects,
+dynamic bindings, let constructs, backtraces, etc.  You might say
+that this module is the very heart of XEmacs, and everything else
+in XEmacs is merely an auxiliary module implementing some specific
+functionality that may be called from the heart at an appropriate
+time.
+The only exception is the alloc.c module, which implements the
+framework upon which this module (eval.c) works.  alloc.c works
+with creating the actual Lisp objects themselves and garbage
+collecting them as necessary, preseting a nice, high-level
+interface for object creation, deletion, access, and modification.
+The only other exception that could be cited is the event-handling
+module in event-stream.c.  From its perspective, it is also the
+heart of XEmacs, and controls exactly what gets done at what time.
+From its perspective, eval.c is merely one of the auxiliary modules
+out there that can be invoked by event-stream.c.
+Although the event-stream-centric view is a convenient fiction that
+makes sense particularly from the user's perspective and from the
+perspective of time, the engine-centric view is actually closest to
+the truth, because anywhere within the event-stream module, you are
+still somewhere in a Lisp backtrace, and event-loops are begun by
+functions such as `command-loop-1', a Lisp function.
+As the Lisp engine is doing its thing, it maintains the state of
+the engine primarily in five list-like items, with are:
+-- the backtrace list
+-- the catchtag list
+-- the condition-handler list
+-- the specbind list
+-- the GCPRO list.
+These are described in detail in the next comment.
+--ben
+*/
+/* Note that there are five separate lists used to maintain state in
+the evaluator.  All of them conceptually are stacks (last-in,
+first-out).  All non-local exits happen ultimately through the
+catch/throw mechanism, which uses one of the five lists (the
+catchtag list) and records the current state of the others in each
+frame of the list (some other information is recorded and restored
+as well, such as the current eval depth), so that all the state of
+the evaluator is restored properly when a non-local exit occurs.
+(Note that the current state of the condition-handler list is not
+recorded in the catchtag list.  Instead, when a condition-case or
+call-with-condition-handler is set up, it installs an
+unwind-protect on the specbind list to restore the appropriate
+setting for the condition-handler list.  During the course of
+handling the non-local exit, all entries on the specbind list that
+are past the location stored in the catch frame are "unwound"
+(i.e. variable bindings are restored and unwind-protects are
+executed), so the condition-handler list gets reset properly.
+The five lists are
+1. The backtrace list, which is chained through `struct backtrace's
+declared in the stack frames of various primitives, and keeps
+track of all Lisp function call entries and exits.
+2. The catchtag list, which is chained through `struct catchtag's
+declared in the stack frames of internal_catch and condition_case_1,
+and keeps track of information needed to reset the internal state
+of the evaluator to the state that was current when the catch or
+condition-case were established, in the event of a non-local exit.
+3. The condition-handler list, which is a simple Lisp list with new
+entries consed onto the front of the list.  It records condition-cases
+and call-with-condition-handlers established either from C or from
+Lisp.  Unlike with the other lists (but similar to everything else
+of a similar nature in the rest of the C and Lisp code), it takes care
+of restoring itself appropriately in the event of a non-local exit
+through the use of the unwind-protect mechanism.
+4. The specbind list, which is a contiguous array of `struct specbinding's,
+expanded as necessary using realloc().  It holds dynamic variable
+bindings (the only kind we currently have in ELisp) and unwind-protects.
+5. The GCPRO list, which is chained through `struct gcpro's declared in
+the stack frames of any functions that need to GC-protect Lisp_Objects
+declared on the stack.  This is one of the most fragile areas of the
+entire scheme -- you must not forget to UNGCPRO at the end of your
+function, you must make sure you GCPRO in many circumstances you don't
+think you have to, etc.  See the internals manual for more information
+about this.
+--ben
+*/
 #include <config.h>
 #include "lisp.h"
 #include "commands.h"
 #include "backtrace.h"
 #include "bytecode.h"
 #include "buffer.h"
 #include "console.h"
+#include "device.h"
+#include "frame.h"
+#include "lstream.h"
 #include "opaque.h"
+#include "window.h"
 struct backtrace *backtrace_list;
 /* Note: you must always fill in all of the fields in a backtrace structure
 before pushing them on the backtrace_list.  The profiling code depends
 (((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
 a SUBR with more than 8 arguments, use max_args == MANY.
+Or better, considering using a property list as one of your args.
 See the DEFUN macro in lisp.h)  */
 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do {			\
 void (*PF_fn)(void) = (void (*)(void)) fn;			\
 Lisp_Object *PF_av = (av);					\
 switch (ac)							\
 #define FUNCALL_SUBR(rv, subr, av, ac) \
 	PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac);
 /* This is the list of current catches (and also condition-cases).
-This is a stack: the most recent catch is at the head of the
+This is a stack: the most recent catch is at the head of the list.
-list.  Catches are created by declaring a 'struct catchtag'
+The list is threaded through the stack frames of the C functions
-locally, filling the .TAG field in with the tag, and doing
+that set up the catches; this is similar to the way the GCPRO list
-a setjmp() on .JMP.  Fthrow() will store the value passed
+is handled, but different from the condition-handler list (which is
-to it in .VAL and longjmp() back to .JMP, back to the function
+a simple Lisp list) and the specbind stack, which is a contiguous
-that established the catch.  This will always be either
+array of `struct specbinding's, grown (using realloc()) as
-internal_catch() (catches established internally or through
+necessary. (Note that all four of these lists behave as a stacks.)
-`catch') or condition_case_1 (condition-cases established
-internally or through `condition-case').
+Catches are created by declaring a 'struct catchtag' locally,
+filling the .TAG field in with the tag, and doing a setjmp() on
+.JMP.  Fthrow() will store the value passed to it in .VAL and
+longjmp() back to .JMP, back to the function that established the
+catch.  This will always be either internal_catch() (catches
+established internally or through `catch') or condition_case_1
+(condition-cases established internally or through
+`condition-case').
 The catchtag also records the current position in the
 call stack (stored in BACKTRACE_LIST), the current position
 in the specpdl stack (used for variable bindings and
 unwind-protects), the value of LISP_EVAL_DEPTH, and the
 current position in the GCPRO stack.  All of these are
 restored by Fthrow().
 */
 struct catchtag *catchlist;
+/* A special tag that can be used internally from C code to catch
+every attempt to throw past this level. */
+Lisp_Object Vcatch_everything_tag;
 Lisp_Object Qautoload, Qmacro, Qexit;
 Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
 Lisp_Object Vquit_flag, Vinhibit_quit;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qsetq;
 Lisp_Object Qdisplay_warning;
 Lisp_Object Vpending_warnings, Vpending_warnings_tail;
 Lisp_Object Qif;
-/* Records whether we want errors to occur.  This will be a boolean,
+/* Flags specifying which operations are currently inhibited. */
-nil (errors OK) or t (no errors).  If t, an error will cause a
+int inhibit_flags;
-throw to Qunbound_suspended_errors_tag.
+/* Buffers, frames, windows, devices, and consoles created since most
-See call_with_suspended_errors(). */
+recent active
-Lisp_Object Vcurrent_error_state;
+call_trapping_problems (INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION).
+*/
-/* Current warning class when warnings occur, or nil for no warnings.
+Lisp_Object Vdeletable_permanent_display_objects;
-Only meaningful when Vcurrent_error_state is non-nil.
-See call_with_suspended_errors(). */
+/* Buffers created since most recent active
-Lisp_Object Vcurrent_warning_class;
+call_trapping_problems (INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION). */
+Lisp_Object Vmodifiable_buffers;
-/* Current warning level when warnings occur, or nil for no warnings.
-Only meaningful when Vcurrent_error_state is non-nil.
-See call_with_suspended_errors(). */
-Lisp_Object Vcurrent_warning_level;
 /* Minimum level at which warnings are logged.  Below this, they're ignored
 entirely -- not even generated. */
 Lisp_Object Vlog_warning_minimum_level;
-/* Special catch tag used in call_with_suspended_errors(). */
-Lisp_Object Qunbound_suspended_errors_tag;
 /* Non-nil means record all fset's and provide's, to be undone
 if the file being autoloaded is not fully loaded.
 They are recorded by being consed onto the front of Vautoload_queue:
 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */
 static int entering_debugger;
 /* Function to call to invoke the debugger */
 Lisp_Object Vdebugger;
-/* Chain of condition handlers currently in effect.
+/* List of condition handlers currently in effect.
-The elements of this chain are contained in the stack frames
+The elements of this lists were at one point in the past
-of Fcondition_case and internal_condition_case.
+threaded through the stack frames of Fcondition_case and
-When an error is signaled (by calling Fsignal, below),
+related functions, but now are stored separately in a normal
-this chain is searched for an element that applies.
+stack.  When an error is signaled (by calling Fsignal, below),
+this list is searched for an element that applies.
 Each element of this list is one of the following:
-A list of a handler function and possibly args to pass to
+-- A list of a handler function and possibly args to pass to the
-the function.  This is a handler established with
+function.  This is a handler established with the Lisp primitive
-`call-with-condition-handler' (q.v.).
+`call-with-condition-handler' or related C function
+call_with_condition_handler():
-A list whose car is Qunbound and whose cdr is Qt.
-This is a special condition-case handler established
+If the handler function is an opaque ptr object, it is a handler
-by C code with condition_case_1().  All errors are
+that was established in C using call_with_condition_handler(),
-trapped; the debugger is not invoked even if
+and the contents of the object are a function pointer which takes
-`debug-on-error' was set.
+three arguments, the signal name and signal data (same arguments
+passed to `signal') and a third Lisp_Object argument, specified
-A list whose car is Qunbound and whose cdr is Qerror.
+in the call to call_with_condition_handler() and stored as the
-This is a special condition-case handler established
+second element of the list containing the handler functionl.
-by C code with condition_case_1().  It is like Qt
-except that the debugger is invoked normally if it is
+If the handler function is a regular Lisp_Object, it is a handler
-called for.
+that was established using `call-with-condition-handler'.
+Currently there are no more arguments in the list containing the
-A list whose car is Qunbound and whose cdr is a list
+handler function, and only one argument is passed to the handler
-of lists (CONDITION-NAME BODY ...) exactly as in
+function: a cons of the signal name and signal data arguments
-`condition-case'.  This is a normal `condition-case'
+passed to `signal'.
-handler.
+-- A list whose car is Qunbound and whose cdr is Qt.  This is a
-Note that in all cases *except* the first, there is a
+special condition-case handler established by C code with
-corresponding catch, whose TAG is the value of
+condition_case_1().  All errors are trapped; the debugger is not
-Vcondition_handlers just after the handler data just
+invoked even if `debug-on-error' was set.
-described is pushed onto it.  The reason is that
-`condition-case' handlers need to throw back to the
+-- A list whose car is Qunbound and whose cdr is Qerror.  This is a
-place where the handler was installed before invoking
+special condition-case handler established by C code with
-it, while `call-with-condition-handler' handlers are
+condition_case_1().  It is like Qt except that the debugger is
-invoked in the environment that `signal' was invoked
+invoked normally if it is called for.
-in.
-*/
+-- A list whose car is Qunbound and whose cdr is a list of lists
+(CONDITION-NAME BODY ...) exactly as in `condition-case'.  This is
+a normal `condition-case' handler.
+Note that in all cases *except* the first, there is a corresponding
+catch, whose TAG is the value of Vcondition_handlers just after the
+handler data just described is pushed onto it.  The reason is that
+`condition-case' handlers need to throw back to the place where the
+handler was installed before invoking it, while
+`call-with-condition-handler' handlers are invoked in the
+environment that `signal' was invoked in.  */
 static Lisp_Object Vcondition_handlers;
+/* I think we should keep this enabled all the time, not just when
+error checking is enabled, because if one of these puppies pops up,
+it will trash the stack if not caught, making it that much harder to
+debug.  It doesn't cause speed loss. */
 #define DEFEND_AGAINST_THROW_RECURSION
 #ifdef DEFEND_AGAINST_THROW_RECURSION
 /* Used for error catching purposes by throw_or_bomb_out */
 static int throw_level;
-#endif
-#ifdef ERROR_CHECK_STRUCTURES
-static void check_error_state_sanity (void);
-#define CHECK_ERROR_STATE_SANITY() check_error_state_sanity ()
-#else
-#define CHECK_ERROR_STATE_SANITY()
 #endif
 /************************************************************************/
 /*			The subr object type				*/
 				     Lisp_Subr);
 /************************************************************************/
 /*			 Entering the debugger				*/
 /************************************************************************/
+static Lisp_Object
+current_warning_level (void)
+{
+if (inhibit_flags & ISSUE_WARNINGS_AT_DEBUG_LEVEL)
+return Qdebug;
+else
+return Qwarning;
+}
 /* unwind-protect used by call_debugger() to restore the value of
 entering_debugger. (We cannot use specbind() because the
 variable is not Lisp-accessible.) */
 {
 int threw;
 Lisp_Object val;
 int speccount;
+debug_on_next_call = 0;
+if (inhibit_flags & INHIBIT_ENTERING_DEBUGGER)
+{
+if (!(inhibit_flags & INHIBIT_WARNING_ISSUE))
+	warn_when_safe
+	  (Qdebugger, current_warning_level (),
+	   "Unable to enter debugger within critical section");
+return Qunbound;
+}
 if (lisp_eval_depth + 20 > max_lisp_eval_depth)
 max_lisp_eval_depth = lisp_eval_depth + 20;
 if (specpdl_size + 40 > max_specpdl_size)
 max_specpdl_size = specpdl_size + 40;
-debug_on_next_call = 0;
+speccount = internal_bind_int (&entering_debugger, 1);
-speccount = specpdl_depth();
+val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0);
-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_1 (speccount, ((threw)
 				? Qunbound /* Not returning a value */
 				: val));
 }
 Lisp_Object active_handlers,
 		      int signal_vars_only,
 		      int *stack_trace_displayed,
 		      int *debugger_entered)
 {
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
 /* This function can GC */
+#else /* reality check */
+/* This function cannot GC because it inhibits GC during its operation */
+#endif
 Lisp_Object val = Qunbound;
 Lisp_Object all_handlers = Vcondition_handlers;
 Lisp_Object temp_data = Qnil;
-int speccount = specpdl_depth();
+int outer_speccount = specpdl_depth();
+int speccount;
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (all_handlers, temp_data);
+#else
+begin_gc_forbidden ();
+#endif
+speccount = specpdl_depth();
 Vcondition_handlers = active_handlers;
 temp_data = Fcons (sig, data); /* needed for skip_debugger */
 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))));
+unbind_to (speccount);
 *debugger_entered = 1;
 }
 if (!entering_debugger && !*stack_trace_displayed
 && wants_debugger (Vstack_trace_on_signal, conditions))
 val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
 *debugger_entered = 1;
 }
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
 UNGCPRO;
+#endif
 Vcondition_handlers = all_handlers;
-return unbind_to_1 (speccount, val);
+return unbind_to_1 (outer_speccount, val);
 }
 /************************************************************************/
 /*		       The basic special forms				*/
 */
 (int nargs, Lisp_Object *args))
 {
 Lisp_Object cond = args[0];
 Lisp_Object body;
 switch (nargs)
 {
 case 1:  body = Qnil; break;
 case 2:  body = args[1]; break;
 default: body = Fcons (Qprogn, Flist (nargs-1, args+1)); break;
 (args))
 {
 /* This function can GC */
 Lisp_Object tag  = Feval (XCAR (args));
 Lisp_Object body = XCDR (args);
-return internal_catch (tag, Fprogn, body, 0);
+return internal_catch (tag, Fprogn, body, 0, 0);
 }
 /* Set up a catch, then call C function FUNC on argument ARG.
 FUNC should return a Lisp_Object.
 This is how catches are done from within C code. */
 Lisp_Object
 internal_catch (Lisp_Object tag,
 Lisp_Object (*func) (Lisp_Object arg),
 Lisp_Object arg,
-int * volatile threw)
+int * volatile threw,
+		Lisp_Object * volatile thrown_tag)
 {
 /* This structure is made part of the chain `catchlist'.  */
 struct catchtag c;
 /* Fill in the components of c, and put it on the list.  */
 c.next = catchlist;
 c.tag = tag;
+c.actual_tag = Qnil;
 c.val = Qnil;
 c.backlist = backtrace_list;
 #if 0 /* FSFmacs */
 /* #### */
 c.handlerlist = handlerlist;
 /* Call FUNC.  */
 if (SETJMP (c.jmp))
 {
 /* Throw works by a longjmp that comes right here.  */
 if (threw) *threw = 1;
+if (thrown_tag) *thrown_tag = c.actual_tag;
 return c.val;
 }
 c.val = (*func) (arg);
 if (threw) *threw = 0;
+if (thrown_tag) *thrown_tag = Qnil;
 catchlist = c.next;
-CHECK_ERROR_STATE_SANITY ();
+check_catchlist_sanity ();
 return c.val;
 }
 /* Unwind the specbind, catch, and handler stacks back to CATCH, and
 specified in the
 This is used for correct unwinding in Fthrow and Fsignal.  */
 static void
-unwind_to_catch (struct catchtag *c, Lisp_Object val)
+unwind_to_catch (struct catchtag *c, Lisp_Object val, Lisp_Object tag)
 {
 REGISTER int last_time;
 /* Unwind the specbind, catch, and handler stacks back to CATCH
 Before each catch is discarded, unbind all special bindings
 /* Save the value somewhere it will be GC'ed.
 (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;
+c->actual_tag = tag;
 #if 0 /* FSFmacs */
 /* Restore the polling-suppression count.  */
 set_poll_suppress_count (catch->poll_suppress_count);
 #endif
 /* Unwind the specpdl stack, and then restore the proper set of
 handlers.  */
 unbind_to (catchlist->pdlcount);
 catchlist = catchlist->next;
-CHECK_ERROR_STATE_SANITY ();
+check_catchlist_sanity ();
 }
 while (! last_time);
 #else
 /* Former XEmacs code.  This is definitely not as correct because
 there may be a number of catches we're unwinding, and a number
 --ben
 */
 /* Unwind the specpdl stack */
 unbind_to (c->pdlcount);
 catchlist = c->next;
-CHECK_ERROR_STATE_SANITY ();
+check_catchlist_sanity ();
 #endif /* Former code */
 gcprolist = c->gcpro;
 backtrace_list = c->backlist;
 lisp_eval_depth = c->lisp_eval_depth;
 occurs is when there's no catch for 'top-level -- the
 'top-level catch and the catch-all error handler are
 established at the same time, in initial_command_loop/
 top_level_1.
-#### Fix this horrifitude!
+[[#### Fix this horrifitude!]]
+I don't think this is horrifitude, just defensive programming. --ben
 */
 while (1)
 {
 REGISTER struct catchtag *c;
 #if 0 /* FSFmacs */
 if (!NILP (tag)) /* #### */
 #endif
 for (c = catchlist; c; c = c->next)
 	{
-	  if (EQ (c->tag, tag))
+	  if (EQ (c->tag, tag) || EQ (c->tag, Vcatch_everything_tag))
-	    unwind_to_catch (c, val);
+	    unwind_to_catch (c, val, tag);
 	}
 if (!bomb_out_p)
 tag = Fsignal (Qno_catch, list2 (tag, val));
 else
 call1 (Qreally_early_error_handler, Fcons (sig, data));
 condition_bind_unwind (Lisp_Object loser)
 {
 /* There is no problem freeing stuff here like there is in
 condition_case_unwind(), because there are no outside pointers
 (like the tag below in the catchlist) pointing to the objects. */
-Lisp_Cons *victim;
 /* ((handler-fun . handler-args) ... other handlers) */
 Lisp_Object tem = XCAR (loser);
+int first = 1;
 while (CONSP (tem))
 {
-victim = XCONS (tem);
+Lisp_Object victim = tem;
-tem = victim->cdr;
+if (first && OPAQUE_PTRP (XCAR (victim)))
+	free_opaque_ptr (XCAR (victim));
+first = 0;
+tem = XCDR (victim);
 free_cons (victim);
 }
-victim = XCONS (loser);
 if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */
-Vcondition_handlers = victim->cdr;
+Vcondition_handlers = XCDR (loser);
-free_cons (victim);
+free_cons (loser);
 return Qnil;
 }
 static Lisp_Object
 condition_case_unwind (Lisp_Object loser)
 functions. --ben */
 c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers),
 			Vcondition_handlers);
 #endif
 c.val = Qnil;
+c.actual_tag = Qnil;
 c.backlist = backtrace_list;
 #if 0 /* FSFmacs */
 /* #### */
 c.handlerlist = handlerlist;
 #endif
 /* Once we change `catchlist' below, the stuff in c will not be GCPRO'd. */
 GCPRO3 (harg, c.val, c.tag);
 catchlist = c.next;
-CHECK_ERROR_STATE_SANITY ();
+check_catchlist_sanity ();
 /* Note: The unbind also resets Vcondition_handlers.  Maybe we should
 delete this here. */
 Vcondition_handlers = XCDR (c.tag);
 unbind_to (speccount);
 UNGCPRO;
 /* free the conses *after* the unbind, because the unbind will run
 condition_case_unwind above. */
-free_cons (XCONS (XCAR (c.tag)));
+free_cons (XCAR (c.tag));
-free_cons (XCONS (c.tag));
+free_cons (c.tag);
 return c.val;
 }
 static Lisp_Object
 run_condition_case_handlers (Lisp_Object val, Lisp_Object var)
 {
 /* This function can GC */
 int speccount = specpdl_depth();
 Lisp_Object tem;
-/* #### If there were a way to check that args[0] were a function
+tem = Ffunction_max_args (args[0]);
-which accepted one arg, that should be done here ... */
+if (! (XINT (Ffunction_min_args (args[0])) <= 1
+	 && (NILP (tem) || 1 <= XINT (tem))))
-/* (handler-fun . handler-args) */
+invalid_argument ("Must be function of one argument", args[0]);
+/* (handler-fun . handler-args)  but currently there are no handler-args */
 tem = noseeum_cons (list1 (args[0]), Vcondition_handlers);
 record_unwind_protect (condition_bind_unwind, tem);
 Vcondition_handlers = tem;
 /* Caller should have GC-protected args */
 return unbind_to_1 (speccount, Ffuncall (nargs - 1, args + 1));
+}
+/* This is the C version of the above function.  It calls FUN, passing it
+ARG, first setting up HANDLER to catch signals in the environment in
+which they were signalled. (HANDLER is only invoked if there was no
+handler (either from condition-case or call-with-condition-handler) set
+later on that handled the signal; therefore, this is a real error.
+HANDLER is invoked with three arguments: the ERROR-SYMBOL and DATA as
+passed to `signal', and HANDLER_ARG.  Originally I made HANDLER_ARG and
+ARG be void * to facilitate passing structures, but I changed to
+Lisp_Objects because all the other C interfaces to catch/condition-case/etc.
+take Lisp_Objects, and it is easy enough to use make_opaque_ptr() et al.
+to convert between Lisp_Objects and structure pointers. */
+Lisp_Object
+call_with_condition_handler (Lisp_Object (*handler) (Lisp_Object, Lisp_Object,
+						     Lisp_Object),
+			     Lisp_Object handler_arg,
+			     Lisp_Object (*fun) (Lisp_Object),
+			     Lisp_Object arg)
+{
+/* This function can GC */
+int speccount = specpdl_depth();
+Lisp_Object tem;
+/* ((handler-fun . (handler-arg . nil)) ... ) */
+tem = noseeum_cons (noseeum_cons (make_opaque_ptr (handler),
+				    noseeum_cons (handler_arg, Qnil)),
+		      Vcondition_handlers);
+record_unwind_protect (condition_bind_unwind, tem);
+Vcondition_handlers = tem;
+return unbind_to_1 (speccount, (*fun) (arg));
 }
 static int
 condition_type_p (Lisp_Object type, Lisp_Object conditions)
 {
 /************************************************************************/
 /*		 the workhorse error-signaling function			*/
 /************************************************************************/
+/* This exists only for debugging purposes, as a place to put a breakpoint
+that won't get signalled for errors occurring when
+call_with_suspended_errors() was invoked. */
+static void
+signal_1 (void)
+{
+}
 /* #### This function has not been synched with FSF.  It diverges
 significantly. */
-static Lisp_Object
+/* The simplest external error function: it would be called
-signal_1 (Lisp_Object sig, Lisp_Object data)
+signal_continuable_error() in the terminology below, but it's
+Lisp-callable. */
+DEFUN ("signal", Fsignal, 2, 2, 0, /*
+Signal a continuable error.  Args are ERROR-SYMBOL, and associated DATA.
+An error symbol is a symbol defined using `define-error'.
+DATA should be a list.  Its elements are printed as part of the error message.
+If the signal is handled, DATA is made available to the handler.
+See also the function `signal-error', and the functions to handle errors:
+`condition-case' and `call-with-condition-handler'.
+Note that this function can return, if the debugger is invoked and the
+user invokes the "return from signal" option.
+*/
+(error_symbol, data))
 {
 /* This function can GC */
-struct gcpro gcpro1, gcpro2;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-Lisp_Object conditions;
+Lisp_Object conditions = Qnil;
-Lisp_Object handlers;
+Lisp_Object handlers = Qnil;
 /* signal_call_debugger() could get called more than once
 (once when a call-with-condition-handler is about to
 be dealt with, and another when a condition-case handler
 is about to be invoked).  So make sure the debugger and/or
 stack trace aren't done more than once. */
 int stack_trace_displayed = 0;
 int debugger_entered = 0;
-GCPRO2 (conditions, handlers);
+/* Fsignal() is one of these functions that's called all the time
+with newly-created Lisp objects.  We allow this; but we must GC-
+protect the objects because all sorts of weird stuff could
+happen. */
+GCPRO4 (conditions, handlers, error_symbol, data);
+if (!(inhibit_flags & CALL_WITH_SUSPENDED_ERRORS))
+signal_1 ();
 if (!initialized)
 {
 /* who knows how much has been initialized?  Safest bet is
 just to bomb out immediately. */
 stderr_out ("Error before initialization is complete!\n");
 abort ();
 }
-if (gc_in_progress || in_display)
+if (gc_in_progress)
-/* This is one of many reasons why you can't run lisp code from redisplay.
+/* We used to abort if in_display:
-There is no sensible way to handle errors there. */
+[[This is one of many reasons why you can't run lisp code from
+redisplay.  There is no sensible way to handle errors there.]]
+The above comment is not correct.
+Inhibit GC until the redisplay code is careful enough to properly
+GCPRO their structures;
+Surround all calls to Lisp code with error-trapping wrappers that
+catch all errors. --ben */
 abort ();
-conditions = Fget (sig, Qerror_conditions, Qnil);
+conditions = Fget (error_symbol, Qerror_conditions, Qnil);
 for (handlers = Vcondition_handlers;
 CONSP (handlers);
 handlers = XCDR (handlers))
 {
 Lisp_Object all_handlers = Vcondition_handlers;
 struct gcpro ngcpro1;
 NGCPRO1 (all_handlers);
 Vcondition_handlers = outer_handlers;
-tem = signal_call_debugger (conditions, sig, data,
+tem = signal_call_debugger (conditions, error_symbol, data,
 				      outer_handlers, 1,
 				      &stack_trace_displayed,
 				      &debugger_entered);
 if (!UNBOUNDP (tem))
 	    RETURN_NUNGCPRO (return_from_signal (tem));
-tem = Fcons (sig, data);
+	  if (OPAQUE_PTRP (handler_fun))
-if (NILP (handler_data))
+	    {
-tem = call1 (handler_fun, tem);
+	      if (NILP (handler_data))
-else
+		{
-{
+		  Lisp_Object (*hfun) (Lisp_Object, Lisp_Object) =
-/* (This code won't be used (for now?).) */
+		    (Lisp_Object (*) (Lisp_Object, Lisp_Object))
-struct gcpro nngcpro1;
+		    (get_opaque_ptr (handler_fun));
-Lisp_Object args[3];
-NNGCPRO1 (args[0]);
+		  tem = (*hfun) (error_symbol, data);
-nngcpro1.nvars = 3;
+		}
-args[0] = handler_fun;
+	      else
-args[1] = tem;
+		{
-args[2] = handler_data;
+		  Lisp_Object (*hfun) (Lisp_Object, Lisp_Object, Lisp_Object) =
-nngcpro1.var = args;
+		    (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object))
-tem = Fapply (3, args);
+		    (get_opaque_ptr (handler_fun));
-NNUNGCPRO;
-}
+		  assert (NILP (XCDR (handler_data)));
+		  tem = (*hfun) (error_symbol, data, XCAR (handler_data));
+		}
+	    }
+	  else
+	    {
+	      tem = Fcons (error_symbol, data);
+	      if (NILP (handler_data))
+		tem = call1 (handler_fun, tem);
+	      else
+		{
+		  /* (This code won't be used (for now?).) */
+		  struct gcpro nngcpro1;
+		  Lisp_Object args[3];
+		  NNGCPRO1 (args[0]);
+		  nngcpro1.nvars = 3;
+		  args[0] = handler_fun;
+		  args[1] = tem;
+		  args[2] = handler_data;
+		  nngcpro1.var = args;
+		  tem = Fapply (3, args);
+		  NNUNGCPRO;
+		}
+	    }
 NUNGCPRO;
 #if 0
 if (!EQ (tem, Qsignal))
 return return_from_signal (tem);
 #endif
 /* 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))
 	{
 UNGCPRO;
-return Fthrow (handlers, Fcons (sig, data));
+return Fthrow (handlers, Fcons (error_symbol, data));
 	}
 /* `error' is used similarly to the way `t' is used, but in
 addition it invokes the debugger if debug_on_error.
 	 This is normally used for the outer command-loop error
 	 handler. */
 else if (EQ (handler_data, Qerror))
 {
-Lisp_Object tem = signal_call_debugger (conditions, sig, data,
+Lisp_Object tem = signal_call_debugger (conditions, error_symbol,
+						  data,
 outer_handlers, 0,
 						  &stack_trace_displayed,
 						  &debugger_entered);
 UNGCPRO;
 if (!UNBOUNDP (tem))
 return return_from_signal (tem);
-tem = Fcons (sig, data);
+tem = Fcons (error_symbol, data);
 return Fthrow (handlers, tem);
 }
 else
 	{
 /* handler established by real (Lisp) condition-case */
 	      Lisp_Object clause = Fcar (h);
 	      Lisp_Object tem = Fcar (clause);
 	      if (condition_type_p (tem, conditions))
 		{
-		  tem = signal_call_debugger (conditions, sig, data,
+		  tem = signal_call_debugger (conditions, error_symbol, data,
 outer_handlers, 1,
 					      &stack_trace_displayed,
 					      &debugger_entered);
 UNGCPRO;
 		  if (!UNBOUNDP (tem))
 return return_from_signal (tem);
 /* Doesn't return */
-tem = Fcons (Fcons (sig, data), Fcdr (clause));
+tem = Fcons (Fcons (error_symbol, data), Fcdr (clause));
 return Fthrow (handlers, tem);
 }
 	    }
 	}
 }
 #### The only time that no handler is present is during
 temacs or perhaps very early in XEmacs.  In both cases,
 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,
+I don't think this is horrifitude, but just defensive coding. --ben */
+signal_call_debugger (conditions, error_symbol, data, Qnil, 0,
 			&stack_trace_displayed,
 			&debugger_entered);
 UNGCPRO;
-throw_or_bomb_out (Qtop_level, Qt, 1, sig, data); /* Doesn't return */
+throw_or_bomb_out (Qtop_level, Qt, 1, error_symbol,
+		     data); /* Doesn't return */
 return Qnil;
 }
 /****************** Error functions class 1 ******************/
 /* Class 1: General functions that signal an error.
 These functions take an error type and a list of associated error
 data. */
-/* The simplest external error function: it would be called
+/* No signal_continuable_error_1(); it's called Fsignal(). */
-signal_continuable_error_1() in the terminology below, but it's
-Lisp-callable. */
-DEFUN ("signal", Fsignal, 2, 2, 0, /*
-Signal a continuable error.  Args are ERROR-SYMBOL, and associated DATA.
-An error symbol is a symbol defined using `define-error'.
-DATA should be a list.  Its elements are printed as part of the error message.
-If the signal is handled, DATA is made available to the handler.
-See also the function `signal-error', and the functions to handle errors:
-`condition-case' and `call-with-condition-handler'.
-Note that this function can return, if the debugger is invoked and the
-user invokes the "return from signal" option.
-*/
-(error_symbol, data))
-{
-/* Fsignal() is one of these functions that's called all the time
-with newly-created Lisp objects.  We allow this; but we must GC-
-protect the objects because all sorts of weird stuff could
-happen. */
-struct gcpro gcpro1;
-GCPRO1 (data);
-if (!NILP (Vcurrent_error_state))
-{
-if (!NILP (Vcurrent_warning_class) && !NILP (Vcurrent_warning_level))
-	warn_when_safe_lispobj (Vcurrent_warning_class, Vcurrent_warning_level,
-				Fcons (error_symbol, data));
-Fthrow (Qunbound_suspended_errors_tag, Qnil);
-abort (); /* Better not get here! */
-}
-RETURN_UNGCPRO (signal_1 (error_symbol, data));
-}
 /* Signal a non-continuable error. */
 DOESNT_RETURN
 signal_error_1 (Lisp_Object sig, Lisp_Object data)
 {
 for (;;)
 Fsignal (sig, data);
 }
-#ifdef ERROR_CHECK_STRUCTURES
-static void
+#ifdef ERROR_CHECK_CATCH
-check_error_state_sanity (void)
-{
+void
+check_catchlist_sanity (void)
+{
+#if 0
+/* vou me tomar no cu!  i just masked andy's missing-unbind
+bug! */
 struct catchtag *c;
 int found_error_tag = 0;
 for (c = catchlist; c; c = c->next)
 {
 	  break;
 	}
 }
 assert (found_error_tag || NILP (Vcurrent_error_state));
-}
+#endif /* vou me tomar no cul */
-#endif
+}
-static Lisp_Object
+void
-restore_current_warning_class (Lisp_Object warning_class)
+check_specbind_stack_sanity (void)
 {
-Vcurrent_warning_class = warning_class;
+}
-return Qnil;
-}
+#endif /* ERROR_CHECK_CATCH */
-static Lisp_Object
-restore_current_warning_level (Lisp_Object warning_level)
-{
-Vcurrent_warning_level = warning_level;
-return Qnil;
-}
-static Lisp_Object
-restore_current_error_state (Lisp_Object error_state)
-{
-Vcurrent_error_state = error_state;
-return Qnil;
-}
-static Lisp_Object
-call_with_suspended_errors_1 (Lisp_Object opaque_arg)
-{
-Lisp_Object val;
-Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
-int speccount = specpdl_depth ();
-if (NILP (Vcurrent_error_state))
-{
-record_unwind_protect (restore_current_error_state,
-			     Vcurrent_error_state);
-Vcurrent_error_state = Qt;
-}
-PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]),
-		     kludgy_args + 2, XINT (kludgy_args[1]));
-return unbind_to_1 (speccount, val);
-}
-/* Many functions would like to do one of three things if an error
-occurs:
-(1) signal the error, as usual.
-(2) silently fail and return some error value.
-(3) do as (2) but issue a warning in the process.
-Currently there's lots of stuff that passes an Error_Behavior
-value and calls maybe_signal_error() and other such functions.
-This approach is inherently error-prone and broken.  A much
-more robust and easier approach is to use call_with_suspended_errors().
-Wrap this around any function in which you might want errors
-to not be errors.
-*/
-Lisp_Object
-call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval,
-			    Lisp_Object class, Error_Behavior errb,
-			    int nargs, ...)
-{
-va_list vargs;
-int speccount;
-Lisp_Object kludgy_args[22];
-Lisp_Object *args = kludgy_args + 2;
-int i;
-assert (SYMBOLP (class)); /* sanity-check */
-assert (!NILP (class));
-assert (nargs >= 0 && nargs < 20);
-va_start (vargs, nargs);
-for (i = 0; i < nargs; i++)
-args[i] = va_arg (vargs, Lisp_Object);
-va_end (vargs);
-/* ERROR_ME means don't trap errors. (However, if errors are
-already trapped, we leave them trapped.)
-Otherwise, we trap errors, and display as warnings if ERROR_ME_WARN.
-If ERROR_ME_NOT, we silently fail.
-If ERROR_ME_DEBUG_WARN, we display a warning, but at warning level to
-`debug'.  Normally these disappear, but can be seen if we changed
-log-warning-minimum-level.
-*/
-/* 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))
-{
-Lisp_Object val;
-PRIMITIVE_FUNCALL (val, fun, args, nargs);
-return val;
-}
-speccount = specpdl_depth ();
-if (NILP (Vcurrent_warning_class))
-{
-/* Don't change the existing class.
-	 #### Should we be consing the two together? */
-record_unwind_protect (restore_current_warning_class,
-			     Vcurrent_warning_class);
-Vcurrent_warning_class = class;
-}
-record_unwind_protect (restore_current_warning_level,
-			 Vcurrent_warning_level);
-Vcurrent_warning_level =
-(ERRB_EQ (errb, ERROR_ME_NOT) ? Qnil :
-ERRB_EQ (errb, ERROR_ME_DEBUG_WARN) ? Qdebug :
-Qwarning);
-{
-int threw;
-Lisp_Object the_retval;
-Lisp_Object opaque1 = make_opaque_ptr (kludgy_args);
-Lisp_Object opaque2 = make_opaque_ptr ((void *) fun);
-struct gcpro gcpro1, gcpro2;
-GCPRO2 (opaque1, opaque2);
-kludgy_args[0] = opaque2;
-kludgy_args[1] = make_int (nargs);
-the_retval = internal_catch (Qunbound_suspended_errors_tag,
-				 call_with_suspended_errors_1,
-				 opaque1, &threw);
-free_opaque_ptr (opaque1);
-free_opaque_ptr (opaque2);
-UNGCPRO;
-/* Use the returned value except in non-local exit, when
-RETVAL applies. */
-/* Some perverse compilers require the perverse cast below.  */
-return unbind_to_1 (speccount,
-		      threw ? *((Lisp_Object*) &(retval)) : the_retval);
-}
-}
 /* Signal a non-continuable error or display a warning or do nothing,
 according to ERRB.  CLASS is the class of warning and should
 refer to what sort of operation is being done (e.g. Qtoolbar,
 Qresource, etc.). */
 /* This is what the QUIT macro calls to signal a quit */
 void
 signal_quit (void)
 {
-/* This function can GC */
+/* This function cannot GC.  GC is prohibited because most callers do
+not expect GC occurring in QUIT.  Remove this if/when that gets fixed.
+--ben */
+int count;
 if (EQ (Vquit_flag, Qcritical))
 debug_on_quit |= 2;		/* set critical bit. */
 Vquit_flag = Qnil;
+count = begin_gc_forbidden ();
 /* note that this is continuable. */
 Fsignal (Qquit, Qnil);
+unbind_to (count);
 }
 /************************ convenience error functions ***********************/
 static Lisp_Object funcall_lambda (Lisp_Object fun,
 				   int nargs, Lisp_Object args[]);
 static int in_warnings;
-static Lisp_Object
-in_warnings_restore (Lisp_Object minimus)
-{
-in_warnings = 0;
-return Qnil;
-}
 void handle_compiled_function_with_and_rest (Lisp_Compiled_Function *f,
 					     int nargs,
 					     Lisp_Object args[]);
 Lisp_Object fun, val, original_fun, original_args;
 int nargs;
 struct backtrace backtrace;
 /* I think this is a pretty safe place to call Lisp code, don't you? */
-while (!in_warnings && !NILP (Vpending_warnings))
+while (!in_warnings && !NILP (Vpending_warnings)
+	 /* well, perhaps not so safe after all! */
+	 && !(inhibit_flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY))
 {
 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-int speccount = specpdl_depth();
 Lisp_Object this_warning_cons, this_warning, class, level, messij;
+int speccount = internal_bind_int (&in_warnings, 1);
-record_unwind_protect (in_warnings_restore, Qnil);
-in_warnings = 1;
 this_warning_cons = Vpending_warnings;
 this_warning = XCAR (this_warning_cons);
 /* in case an error occurs in the warn function, at least
 	 it won't happen infinitely */
 Vpending_warnings = XCDR (Vpending_warnings);
-free_cons (XCONS (this_warning_cons));
+free_cons (this_warning_cons);
 class = XCAR (this_warning);
 level = XCAR (XCDR (this_warning));
 messij = XCAR (XCDR (XCDR (this_warning)));
 free_list (this_warning);
 DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /*
 Return the minimum number of arguments a function may be called with.
 The function may be any form that can be passed to `funcall',
 any special form, or any macro.
+To check if a function can be called with a specified number of
+arguments, use `function-allows-args'.
 */
 (function))
 {
 return function_argcount (function, 1);
 }
 Return the maximum number of arguments a function may be called with.
 The function may be any form that can be passed to `funcall',
 any special form, or any macro.
 If the function takes an arbitrary number of arguments or is
 a built-in special form, nil is returned.
+To check if a function can be called with a specified number of
+arguments, use `function-allows-args'.
 */
 (function))
 {
 return function_argcount (function, 0);
 }
 return run_hook_with_args_in_buffer (current_buffer, nargs, args, cond);
 }
 #if 0
-/* From FSF 19.30, not currently used */
+/* From FSF 19.30, not currently used; seems like a big kludge. */
 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
 present value of that symbol.
 Call each element of FUNLIST,
 passing each of them the rest of ARGS.
 except that it isn't necessary to gcpro ARGS[0].  */
 Lisp_Object
 run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
 {
-Lisp_Object sym = args[0];
+omitted;
-Lisp_Object val;
-struct gcpro gcpro1, gcpro2;
-GCPRO2 (sym, val);
-for (val = funlist; CONSP (val); val = XCDR (val))
-{
-if (EQ (XCAR (val), Qt))
-	{
-	  /* t indicates this hook has a local binding;
-	     it means to run the global binding too.  */
-	  Lisp_Object globals;
-	  for (globals = Fdefault_value (sym);
-	       CONSP (globals);
-	       globals = XCDR (globals))
-	    {
-	      args[0] = XCAR (globals);
-	      /* In a global value, t should not occur.  If it does, we
-		 must ignore it to avoid an endless loop.  */
-	      if (!EQ (args[0], Qt))
-		Ffuncall (nargs, args);
-	    }
-	}
-else
-	{
-	  args[0] = XCAR (val);
-	  Ffuncall (nargs, args);
-	}
-}
-UNGCPRO;
-return Qnil;
 }
 #endif /* 0 */
 void
 }
 Lisp_Object
 run_hook (Lisp_Object hook)
 {
-Frun_hooks (1, &hook);
+return run_hook_with_args (1, &hook, RUN_HOOKS_TO_COMPLETION);
-return Qnil;
 }
 /************************************************************************/
 /*		    Front-ends to eval, funcall, apply			*/
 /************************************************************************/
 /*	   Error-catching front-ends to eval, funcall, apply		*/
 /************************************************************************/
-/* Call function fn on no arguments, with condition handler */
+int
+get_inhibit_flags (void)
+{
+return inhibit_flags;
+}
+void
+check_allowed_operation (int what, Lisp_Object obj, Lisp_Object prop)
+{
+if (inhibit_flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
+{
+if (what == OPERATION_MODIFY_BUFFER_TEXT && BUFFERP (obj)
+	  && NILP (memq_no_quit (obj, Vmodifiable_buffers)))
+	invalid_change
+	  ("Modification of this buffer not currently permitted", obj);
+}
+if (inhibit_flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
+{
+if (what == OPERATION_DELETE_OBJECT
+	  && (BUFFERP (obj) || WINDOWP (obj) || FRAMEP (obj) || DEVICEP (obj)
+	      || CONSOLEP (obj))
+	  && NILP (memq_no_quit (obj, Vdeletable_permanent_display_objects)))
+	invalid_change
+	  ("Deletion of this object not currently permitted", obj);
+}
+}
+void
+note_object_created (Lisp_Object obj)
+{
+if (inhibit_flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
+{
+if (BUFFERP (obj))
+	Vmodifiable_buffers = Fcons (obj, Vmodifiable_buffers);
+}
+if (inhibit_flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
+{
+if (BUFFERP (obj) || WINDOWP (obj) || FRAMEP (obj) || DEVICEP (obj)
+	  || CONSOLEP (obj))
+	Vdeletable_permanent_display_objects =
+	  Fcons (obj, Vdeletable_permanent_display_objects);
+}
+}
+void
+note_object_deleted (Lisp_Object obj)
+{
+if (inhibit_flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
+{
+if (BUFFERP (obj))
+	Vmodifiable_buffers = delq_no_quit (obj, Vmodifiable_buffers);
+}
+if (inhibit_flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
+{
+if (BUFFERP (obj) || WINDOWP (obj) || FRAMEP (obj) || DEVICEP (obj)
+	  || CONSOLEP (obj))
+	Vdeletable_permanent_display_objects =
+	  delq_no_quit (obj, Vdeletable_permanent_display_objects);
+}
+}
+struct call_trapping_problems
+{
+Lisp_Object catchtag;
+Lisp_Object error_conditions;
+Lisp_Object data;
+Lisp_Object backtrace;
+Lisp_Object warning_class;
+const CIntbyte *warning_string;
+Lisp_Object (*fun) (void *);
+void *arg;
+};
+static Lisp_Object
+flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
+		    Lisp_Object opaque)
+{
+struct call_trapping_problems *p =
+(struct call_trapping_problems *) get_opaque_ptr (opaque);
+struct gcpro gcpro1;
+Lisp_Object lstream = Qnil;
+Lisp_Object errstr;
+int speccount = specpdl_depth ();
+if (! (inhibit_flags & INHIBIT_WARNING_ISSUE))
+{
+/* We're no longer protected against errors or quit here, so at
+	 least let's temporarily inhibit quit.  We definitely do not
+	 want to inhibit quit during the calling of the function
+	 itself!!!!!!!!!!! */
+specbind (Qinhibit_quit, Qt);
+GCPRO1 (lstream);
+lstream = make_resizing_buffer_output_stream ();
+Fbacktrace (lstream, Qt);
+Lstream_flush (XLSTREAM (lstream));
+p->backtrace = resizing_buffer_to_lisp_string (XLSTREAM (lstream));
+Lstream_delete (XLSTREAM (lstream));
+UNGCPRO;
+/* #### This should call
+	 (with-output-to-string (display-error (cons error_conditions data))
+	 but that stuff is all in Lisp currently. */
+errstr =
+	emacs_sprintf_string_lisp
+	("%s: (%s %s)\n\nBacktrace follows:\n\n%s",
+	 Qnil, 4,
+	 build_msg_string (p->warning_string ? p->warning_string : "error"),
+	 error_conditions, data, p->backtrace);
+warn_when_safe_lispobj (p->warning_class, current_warning_level (),
+			      errstr);
+unbind_to (speccount);
+}
+else
+p->backtrace = Qnil;
+p->error_conditions = error_conditions;
+p->data = data;
+Fthrow (p->catchtag, Qnil);
+return Qnil; /* not reached */
+}
+static Lisp_Object
+call_trapping_problems_2 (Lisp_Object opaque)
+{
+struct call_trapping_problems *p =
+(struct call_trapping_problems *) get_opaque_ptr (opaque);
+return (p->fun) (p->arg);
+}
+static Lisp_Object
+call_trapping_problems_1 (Lisp_Object opaque)
+{
+return call_with_condition_handler (flagged_a_squirmer, opaque,
+				      call_trapping_problems_2, opaque);
+}
+/* This is equivalent to (*fun) (arg), except that various conditions
+can be trapped or inhibited, according to FLAGS.
+If FLAGS does not contain NO_INHIBIT_ERRORS, when an error occurs,
+the error is caught and a warning is issued, specifying the
+specific error that occurred and a backtrace.  In that case,
+WARNING_STRING should be given, and will be printed at the
+beginning of the error to indicate where the error occurred.
+If FLAGS does not contain NO_INHIBIT_THROWS, all attempts to
+`throw' out of the function being called are trapped, and a warning
+issued. (Again, WARNING_STRING should be given.)
+(If FLAGS contains INHIBIT_WARNING_ISSUE, no warnings are issued;
+this applies to recursive invocations of call_trapping_problems, too.
+If FLAGS contains ISSUE_WARNINGS_AT_DEBUG_LEVEL, warnings will be
+issued, but at level `debug', which normally is below the minimum
+specified by `log-warning-minimum-level', meaning such warnings will
+be ignored entirely.  The user can change this variable, however,
+to see the warnings.)
+Note: If neither of NO_INHIBIT_THROWS or NO_INHIBIT_ERRORS is
+given, you are *guaranteed* that there will be no non-local exits
+out of this function.
+If FLAGS contains INHIBIT_QUIT, QUIT using C-g is inhibited.  (This
+is *rarely* a good idea.  Unless you use NO_INHIBIT_ERRORS, QUIT is
+automatically caught as well, and treated as an error; you can
+check for this using EQ (problems->error_conditions, Qquit).
+If FLAGS contains UNINHIBIT_QUIT, QUIT checking will be explicitly
+turned on. (It will abort the code being called, but will still be
+trapped and reported as an error, unless NO_INHIBIT_ERRORS is
+given.) This is useful when QUIT checking has been turned off by a
+higher-level caller.
+If FLAGS contains INHIBIT_GC, garbage collection is inhibited.
+This is useful for Lisp called within redisplay or inside of the
+QUIT macro (where GC is generally not expected), for example.
+If FLAGS contains INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION,
+Lisp code is not allowed to delete any window, buffers, frames, devices,
+or consoles that were already in existence at the time this function
+was called. (However, it's perfectly legal for code to create a new
+buffer and then delete it.)
+#### It might be useful to have a flag that inhibits deletion of a
+specific permanent display object and everything it's attached to
+(e.g. a window, and the buffer, frame, device, and console it's
+attached to.
+If FLAGS contains INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION, Lisp
+code is not allowed to modify the text of any buffers that were
+already in existence at the time this function was called.
+(However, it's perfectly legal for code to create a new buffer and
+then modify its text.)
+[These last two flags are implemented using global variables
+Vdeletable_permanent_display_objects and Vmodifiable_buffers,
+which keep track of a list of all buffers or permanent display
+objects created since the last time one of these flags was set.
+The code that deletes buffers, etc. and modifies buffers checks
+(1) if the corresponding flag is set (through the global variable
+inhibit_flags or its accessor function get_inhibit_flags()), and
+(2) if the object to be modified or deleted is not in the
+appropriate list.
+If so, it signals an error.
+Recursive calls to call_trapping_problems() are allowed.  In
+the case of the two flags mentioned above, the current values
+of the global variables are stored in an unwind-protect, and
+they're reset to nil.]
+If FLAGS contains INHIBIT_ENTERING_DEBUGGER, the debugger will not
+be entered if an error occurs inside the Lisp code being called,
+even when the user has requested an error.  In such case, a warning
+is issued stating that access to the debugger is denied, unless
+INHIBIT_WARNING_ISSUE has also been supplied.  This is useful when
+calling Lisp code inside redisplay, in menu callbacks, etc. because
+in such cases either the display is in an inconsistent state or
+doing window operations is explicitly forbidden by the OS, and the
+debugger would causes visual changes on the screen and might create
+another frame.
+If FLAGS contains INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY, no
+changes of any sort to extents, faces, glyphs, buffer text,
+specifiers relating to display, other variables relating to
+display, splitting, deleting, or resizing windows or frames,
+deleting buffers, windows, frames, devices, or consoles, etc. is
+allowed.  This is for things called absolutely in the middle of
+redisplay, which expects things to be *exactly* the same after the
+call as before.  This isn't completely implemented and needs to be
+thought out some more to determine exactly what its semantics are.
+For the moment, turning on this flag also turns on
+INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION
+INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION
+INHIBIT_ENTERING_DEBUGGER
+INHIBIT_WARNING_ISSUE
+INHIBIT_GC
+#### The following five flags are defined, but unimplemented:
+#define INHIBIT_EXISTING_CODING_SYSTEM_DELETION (1<<6)
+#define INHIBIT_EXISTING_CHARSET_DELETION (1<<7)
+#define INHIBIT_PERMANENT_DISPLAY_OBJECT_CREATION (1<<8)
+#define INHIBIT_CODING_SYSTEM_CREATION (1<<9)
+#define INHIBIT_CHARSET_CREATION (1<<10)
+FLAGS containing CALL_WITH_SUSPENDED_ERRORS is a sign that
+call_with_suspended_errors() was invoked.  This exists only for
+debugging purposes -- often we want to break when a signal happens,
+but ignore signals from call_with_suspended_errors(), because they
+occur often and for legitimate reasons.
+If PROBLEM is non-zero, it should be a pointer to a structure into
+which exact information about any occurring problems (either an
+error or an attempted throw past this boundary).
+If a problem occurred and aborted operation (error, quit, or
+invalid throw), Qunbound is returned.  Otherwise the return value
+from the call to (*fun) (arg) is returned.  */
 Lisp_Object
-call0_with_handler (Lisp_Object handler, Lisp_Object fn)
+call_trapping_problems (Lisp_Object warning_class,
-{
+			const CIntbyte *warning_string,
-/* This function can GC */
+			int flags,
+			struct call_trapping_problems_result *problem,
+			Lisp_Object (*fun) (void *),
+			void *arg)
+{
+int speccount = specpdl_depth();
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+struct call_trapping_problems package;
+Lisp_Object opaque, thrown_tag, tem;
+int thrown = 0;
+assert (SYMBOLP (warning_class)); /* sanity-check */
+assert (!NILP (warning_class));
+flags ^= INTERNAL_INHIBIT_ERRORS | INTERNAL_INHIBIT_THROWS;
+package.warning_class = warning_class;
+package.warning_string = warning_string;
+package.fun = fun;
+package.arg = arg;
+package.catchtag =
+flags & INTERNAL_INHIBIT_THROWS ? Vcatch_everything_tag :
+flags & INTERNAL_INHIBIT_ERRORS ? make_opaque_ptr (0) :
+Qnil;
+package.error_conditions = Qnil;
+package.data = Qnil;
+package.backtrace = Qnil;
+if (flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY)
+flags |= INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION
+| INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION
+| INHIBIT_ENTERING_DEBUGGER
+| INHIBIT_WARNING_ISSUE
+| INHIBIT_GC;
+{
+int new_inhibit_flags = inhibit_flags | flags;
+if (new_inhibit_flags != inhibit_flags)
+internal_bind_int (&inhibit_flags, new_inhibit_flags);
+}
+if (flags & INHIBIT_QUIT)
+specbind (Qinhibit_quit, Qt);
+if (flags & UNINHIBIT_QUIT)
+begin_do_check_for_quit ();
+if (flags & INHIBIT_GC)
+begin_gc_forbidden ();
+/* #### If we have nested calls to call_trapping_problems(), and the
+inner one creates some buffers/etc., should the outer one be able
+to delete them?  I think so, but it means we need to combine rather
+than just reset the value. */
+if (flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
+internal_bind_lisp_object (&Vdeletable_permanent_display_objects, Qnil);
+if (flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
+internal_bind_lisp_object (&Vmodifiable_buffers, Qnil);
+if (flags & (INTERNAL_INHIBIT_THROWS | INTERNAL_INHIBIT_ERRORS))
+opaque = make_opaque_ptr (&package);
+else
+opaque = Qnil;
+GCPRO5 (package.catchtag, package.error_conditions, package.data,
+	  package.backtrace, opaque);
+if (flags & INTERNAL_INHIBIT_ERRORS)
+/* We need a catch so that our condition-handler can throw back here
+after printing the warning. (We print the warning in the stack
+context of the error, so we can get a backtrace.) */
+tem = internal_catch (package.catchtag, call_trapping_problems_1, opaque,
+			  &thrown, &thrown_tag);
+else if (flags & INTERNAL_INHIBIT_THROWS)
+/* We skip over the first wrapper, which traps errors. */
+tem = internal_catch (package.catchtag, call_trapping_problems_2, opaque,
+			  &thrown, &thrown_tag);
+else
+/* Nothing special. */
+tem = (fun) (arg);
+if (thrown && !EQ (thrown_tag, package.catchtag)
+&& (!flags & INHIBIT_WARNING_ISSUE))
+{
+Lisp_Object errstr;
+if (!(flags & INHIBIT_QUIT))
+	/* We're no longer protected against errors or quit here, so at
+	   least let's temporarily inhibit quit. */
+	specbind (Qinhibit_quit, Qt);
+errstr =
+	emacs_sprintf_string_lisp
+	("%s: Attempt to throw outside of function "
+	 "to catch `%s' with value `%s'",
+	 Qnil, 3, build_msg_string (warning_string ? warning_string : "error"),
+	 thrown_tag, tem);
+warn_when_safe_lispobj (Qerror, current_warning_level (), errstr);
+}
+if (problem)
+{
+if (!thrown)
+	{
+	  problem->caught_error = 0;
+	  problem->caught_throw = 0;
+	  problem->error_conditions = Qnil;
+	  problem->data = Qnil;
+	  problem->backtrace = Qnil;
+	  problem->thrown_tag = Qnil;
+	  problem->thrown_value = Qnil;
+	}
+else if (EQ (thrown_tag, package.catchtag))
+	{
+	  problem->caught_error = 1;
+	  problem->caught_throw = 0;
+	  problem->error_conditions = package.error_conditions;
+	  problem->data = package.data;
+	  problem->backtrace = package.backtrace;
+	  problem->thrown_tag = Qnil;
+	  problem->thrown_value = Qnil;
+	}
+else
+	{
+	  problem->caught_error = 0;
+	  problem->caught_throw = 1;
+	  problem->error_conditions = Qnil;
+	  problem->data = Qnil;
+	  problem->backtrace = Qnil;
+	  problem->thrown_tag = thrown_tag;
+	  problem->thrown_value = tem;
+	}
+}
+if (!NILP (package.catchtag) &&
+!EQ (package.catchtag, Vcatch_everything_tag))
+free_opaque_ptr (package.catchtag);
+if (!NILP (opaque))
+free_opaque_ptr (opaque);
+unbind_to (speccount);
+RETURN_UNGCPRO (thrown ? Qunbound : tem);
+}
+struct va_call_trapping_problems
+{
+lisp_fn_t fun;
+int nargs;
+Lisp_Object *args;
+};
+static Lisp_Object
+va_call_trapping_problems_1 (void *ai_mi_madre)
+{
+struct va_call_trapping_problems *ai_no_corrida =
+(struct va_call_trapping_problems *) ai_mi_madre;
+Lisp_Object pegar_no_bumbum;
+PRIMITIVE_FUNCALL (pegar_no_bumbum, ai_no_corrida->fun,
+		     ai_no_corrida->args, ai_no_corrida->nargs);
+return pegar_no_bumbum;
+}
+/* #### document me. */
+Lisp_Object
+va_call_trapping_problems (Lisp_Object warning_class,
+			   const CIntbyte *warning_string,
+			   int flags,
+			   struct call_trapping_problems_result *problem,
+			   lisp_fn_t fun, int nargs, ...)
+{
+va_list vargs;
+Lisp_Object args[20];
+int i;
+struct va_call_trapping_problems fazer_invocacao_atrapalhando_problemas;
 struct gcpro gcpro1;
+assert (nargs >= 0 && nargs < 20);
+va_start (vargs, nargs);
+for (i = 0; i < nargs; i++)
+args[i] = va_arg (vargs, Lisp_Object);
+va_end (vargs);
+fazer_invocacao_atrapalhando_problemas.fun = fun;
+fazer_invocacao_atrapalhando_problemas.nargs = nargs;
+fazer_invocacao_atrapalhando_problemas.args = args;
+GCPRO1_ARRAY (args, nargs);
+RETURN_UNGCPRO
+(call_trapping_problems
+(warning_class, warning_string, flags, problem,
+va_call_trapping_problems_1, &fazer_invocacao_atrapalhando_problemas));
+}
+/* this is an older interface, barely different from
+va_call_trapping_problems.
+#### eliminate this or at least merge the ERROR_BEHAVIOR stuff into
+va_call_trapping_problems(). */
+Lisp_Object
+call_with_suspended_errors (lisp_fn_t fun, Lisp_Object retval,
+			    Lisp_Object class, Error_Behavior errb,
+			    int nargs, ...)
+{
+va_list vargs;
+Lisp_Object args[20];
+int i;
+struct va_call_trapping_problems fazer_invocacao_atrapalhando_problemas;
+int flags;
+struct gcpro gcpro1;
+assert (SYMBOLP (class)); /* sanity-check */
+assert (!NILP (class));
+assert (nargs >= 0 && nargs < 20);
+va_start (vargs, nargs);
+for (i = 0; i < nargs; i++)
+args[i] = va_arg (vargs, Lisp_Object);
+va_end (vargs);
+/* If error-checking is not disabled, just call the function. */
+if (ERRB_EQ (errb, ERROR_ME))
+{
+Lisp_Object val;
+PRIMITIVE_FUNCALL (val, fun, args, nargs);
+return val;
+}
+if (ERRB_EQ (errb, ERROR_ME_NOT)) /* person wants no warnings */
+flags = INHIBIT_WARNING_ISSUE | INHIBIT_ENTERING_DEBUGGER;
+else if (ERRB_EQ (errb, ERROR_ME_DEBUG_WARN))
+flags = ISSUE_WARNINGS_AT_DEBUG_LEVEL | INHIBIT_ENTERING_DEBUGGER;
+else
+{
+assert (ERRB_EQ (errb, ERROR_ME_WARN));
+flags = INHIBIT_ENTERING_DEBUGGER;
+}
+flags |= CALL_WITH_SUSPENDED_ERRORS;
+fazer_invocacao_atrapalhando_problemas.fun = fun;
+fazer_invocacao_atrapalhando_problemas.nargs = nargs;
+fazer_invocacao_atrapalhando_problemas.args = args;
+GCPRO1_ARRAY (args, nargs);
+{
+Lisp_Object its_way_too_goddamn_late =
+call_trapping_problems
+(class, 0, flags, 0, va_call_trapping_problems_1,
+	&fazer_invocacao_atrapalhando_problemas);
+UNGCPRO;
+if (UNBOUNDP (its_way_too_goddamn_late))
+return retval;
+else
+return its_way_too_goddamn_late;
+}
+}
+struct calln_trapping_problems
+{
+int nargs;
+Lisp_Object *args;
+};
+static Lisp_Object
+calln_trapping_problems_1 (void *puta)
+{
+struct calln_trapping_problems *p = (struct calln_trapping_problems *) puta;
+return Ffuncall (p->nargs, p->args);
+}
+static Lisp_Object
+calln_trapping_problems (Lisp_Object warning_class,
+			 const CIntbyte *warning_string, int flags,
+			 struct call_trapping_problems_result *problem,
+			 int nargs, Lisp_Object *args)
+{
+struct calln_trapping_problems foo;
+struct gcpro gcpro1;
+if (SYMBOLP (args[0]))
+{
+Lisp_Object tem = XSYMBOL (args[0])->function;
+if (NILP (tem) || UNBOUNDP (tem))
+	{
+	  if (problem)
+	    {
+	      problem->caught_error = 0;
+	      problem->caught_throw = 0;
+	      problem->error_conditions = Qnil;
+	      problem->data = Qnil;
+	      problem->backtrace = Qnil;
+	      problem->thrown_tag = Qnil;
+	      problem->thrown_value = Qnil;
+	    }
+	  return Qnil;
+	}
+}
+foo.nargs = nargs;
+foo.args = args;
+GCPRO1_ARRAY (args, nargs);
+RETURN_UNGCPRO (call_trapping_problems (warning_class, warning_string,
+					  flags, problem,
+					  calln_trapping_problems_1,
+					  &foo));
+}
+/* #### fix these functions to follow the calling convention of
+call_trapping_problems! */
+Lisp_Object
+call0_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
+			 int flags)
+{
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 1,
+				  &function);
+}
+Lisp_Object
+call1_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
+			 Lisp_Object object, int flags)
+{
 Lisp_Object args[2];
-args[0] = handler;
-args[1] = fn;
+args[0] = function;
-GCPRO1 (args[0]);
+args[1] = object;
-gcpro1.nvars = 2;
-RETURN_UNGCPRO (Fcall_with_condition_handler (2, args));
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 2,
-}
+				  args);
+}
-/* Call function fn with argument arg0, with condition handler */
 Lisp_Object
-call1_with_handler (Lisp_Object handler, Lisp_Object fn,
+call2_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
-Lisp_Object arg0)
+			 Lisp_Object object1, Lisp_Object object2,
-{
+			 int flags)
-/* This function can GC */
+{
-struct gcpro gcpro1;
 Lisp_Object args[3];
-args[0] = handler;
-args[1] = fn;
+args[0] = function;
-args[2] = arg0;
+args[1] = object1;
-GCPRO1 (args[0]);
+args[2] = object2;
-gcpro1.nvars = 3;
-RETURN_UNGCPRO (Fcall_with_condition_handler (3, args));
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 3,
-}
+				  args);
+}
-/* The following functions provide you with error-trapping versions
+Lisp_Object
-of the various front-ends above.  They take an additional
+call3_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
-"warning_string" argument; if non-zero, a warning with this
+			 Lisp_Object object1, Lisp_Object object2,
-string and the actual error that occurred will be displayed
+			 Lisp_Object object3, int flags)
-in the *Warnings* buffer if an error occurs.  In all cases,
+{
-QUIT is inhibited while these functions are running, and if
+Lisp_Object args[4];
-an error occurs, Qunbound is returned instead of the normal
-return value.
+args[0] = function;
-*/
+args[1] = object1;
+args[2] = object2;
-/* #### This stuff needs to catch throws as well.  We need to
+args[3] = object3;
-improve internal_catch() so it can take a "catch anything"
-argument similar to Qt or Qerror for condition_case_1(). */
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 4,
+				  args);
+}
+Lisp_Object
+call4_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
+			 Lisp_Object object1, Lisp_Object object2,
+			 Lisp_Object object3, Lisp_Object object4,
+			 int flags)
+{
+Lisp_Object args[5];
+args[0] = function;
+args[1] = object1;
+args[2] = object2;
+args[3] = object3;
+args[4] = object4;
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 5,
+				  args);
+}
+Lisp_Object
+call5_trapping_problems (const CIntbyte *warning_string, Lisp_Object function,
+			 Lisp_Object object1, Lisp_Object object2,
+			 Lisp_Object object3, Lisp_Object object4,
+			 Lisp_Object object5, int flags)
+{
+Lisp_Object args[6];
+args[0] = function;
+args[1] = object1;
+args[2] = object2;
+args[3] = object3;
+args[4] = object4;
+args[5] = object5;
+return calln_trapping_problems (Qerror, warning_string, flags, 0, 6,
+				  args);
+}
+struct eval_in_buffer_trapping_problems
+{
+struct buffer *buf;
+Lisp_Object form;
+};
 static Lisp_Object
-caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+eval_in_buffer_trapping_problems_1 (void *arg)
 {
-/* #### should be rewritten to work with emacs_sprintf_string_lisp(); but this
+struct eval_in_buffer_trapping_problems *p =
-whole stuff is getting junked and replaced from my stderr-proc ws */
+(struct eval_in_buffer_trapping_problems *) arg;
-if (!NILP (errordata))
-{
+return eval_in_buffer (p->buf, p->form);
-Lisp_Object args[2];
+}
-if (!NILP (arg))
+/* #### fix these functions to follow the calling convention of
-{
+call_trapping_problems! */
-Intbyte *str = (Intbyte *) get_opaque_ptr (arg);
-args[0] = build_intstring (str);
+Lisp_Object
-}
+eval_in_buffer_trapping_problems (const CIntbyte *warning_string,
-else
+				  struct buffer *buf, Lisp_Object form,
-args[0] = build_msg_string ("error");
+				  int flags)
-/* #### This should call
+{
-	 (with-output-to-string (display-error errordata))
+struct eval_in_buffer_trapping_problems p;
-	 but that stuff is all in Lisp currently. */
+Lisp_Object buffer = wrap_buffer (buf);
-args[1] = errordata;
+struct gcpro gcpro1, gcpro2;
-warn_when_safe_lispobj
-	(Qerror, Qwarning,
+GCPRO2 (buffer, form);
-	 emacs_vsprintf_string_lisp ("%s: %s", Qnil, 2, args));
+p.buf = buf;
-}
+p.form = form;
-return Qunbound;
+RETURN_UNGCPRO (call_trapping_problems (Qerror, warning_string, flags, 0,
+					  eval_in_buffer_trapping_problems_1,
+					  &p));
+}
+Lisp_Object
+run_hook_trapping_problems (const CIntbyte *warning_string,
+			    Lisp_Object hook_symbol,
+			    int flags)
+{
+return run_hook_with_args_trapping_problems (warning_string, 1, &hook_symbol,
+					       RUN_HOOKS_TO_COMPLETION,
+					       flags);
 }
 static Lisp_Object
-allow_quit_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+safe_run_hook_trapping_problems_1 (void *puta)
 {
-if (CONSP (errordata) && EQ (XCAR (errordata), Qquit))
+Lisp_Object hook = VOID_TO_LISP (puta);
-return Fsignal (Qquit, XCDR (errordata));
-return caught_a_squirmer (errordata, arg);
+run_hook (hook);
-}
+return Qnil;
+}
-static Lisp_Object
-safe_run_hook_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+/* Same as run_hook_trapping_problems() but also set the hook to nil
-{
+if an error occurs (but not a quit). */
-Lisp_Object hook = Fcar (arg);
-arg = Fcdr (arg);
-/* Clear out the hook. */
-Fset (hook, Qnil);
-return caught_a_squirmer (errordata, arg);
-}
-static Lisp_Object
-allow_quit_safe_run_hook_caught_a_squirmer (Lisp_Object errordata,
-					    Lisp_Object arg)
-{
-Lisp_Object hook = Fcar (arg);
-arg = Fcdr (arg);
-if (!CONSP (errordata) || !EQ (XCAR (errordata), Qquit))
-/* Clear out the hook. */
-Fset (hook, Qnil);
-return allow_quit_caught_a_squirmer (errordata, arg);
-}
-static Lisp_Object
-catch_them_squirmers_eval_in_buffer (Lisp_Object cons)
-{
-return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons));
-}
 Lisp_Object
-eval_in_buffer_trapping_errors (const CIntbyte *warning_string,
+safe_run_hook_trapping_problems (const CIntbyte *warning_string,
-				struct buffer *buf, Lisp_Object form)
+				 Lisp_Object hook_symbol,
-{
+				 int flags)
-int speccount = specpdl_depth();
+{
 Lisp_Object tem;
-Lisp_Object buffer;
-Lisp_Object cons;
-Lisp_Object opaque;
 struct gcpro gcpro1, gcpro2;
+struct call_trapping_problems_result prob;
-buffer = wrap_buffer (buf);
-specbind (Qinhibit_quit, Qt);
-/* begin_gc_forbidden(); Currently no reason to do this; */
-cons = noseeum_cons (buffer, form);
-opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
-GCPRO2 (cons, opaque);
-/* Qerror not Qt, so you can get a backtrace */
-tem = condition_case_1 (Qerror,
-catch_them_squirmers_eval_in_buffer, cons,
-			  caught_a_squirmer, opaque);
-free_cons (XCONS (cons));
-if (OPAQUE_PTRP (opaque))
-free_opaque_ptr (opaque);
-UNGCPRO;
-return unbind_to_1 (speccount, tem);
-}
-static Lisp_Object
-catch_them_squirmers_run_hook (Lisp_Object hook_symbol)
-{
-/* This function can GC */
-run_hook (hook_symbol);
-return Qnil;
-}
-Lisp_Object
-run_hook_trapping_errors (const CIntbyte *warning_string,
-			  Lisp_Object hook_symbol)
-{
-int speccount;
-Lisp_Object tem;
-Lisp_Object opaque;
-struct gcpro gcpro1;
 if (!initialized || preparing_for_armageddon)
 return Qnil;
 tem = find_symbol_value (hook_symbol);
 if (NILP (tem) || UNBOUNDP (tem))
 return Qnil;
-speccount = specpdl_depth();
+GCPRO2 (hook_symbol, tem);
-specbind (Qinhibit_quit, Qt);
+tem = call_trapping_problems (Qerror, warning_string, flags,
+				&prob,
-opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
+				safe_run_hook_trapping_problems_1,
-GCPRO1 (opaque);
+				LISP_TO_VOID (hook_symbol));
-/* Qerror not Qt, so you can get a backtrace */
+if (prob.caught_throw || (prob.caught_error && !EQ (prob.error_conditions,
-tem = condition_case_1 (Qerror,
+						      Qquit)))
-catch_them_squirmers_run_hook, hook_symbol,
+Fset (hook_symbol, Qnil);
-caught_a_squirmer, opaque);
+RETURN_UNGCPRO (tem);
-if (OPAQUE_PTRP (opaque))
+}
-free_opaque_ptr (opaque);
-UNGCPRO;
+struct run_hook_with_args_in_buffer_trapping_problems
+{
-return unbind_to_1 (speccount, tem);
+struct buffer *buf;
-}
+int nargs;
+Lisp_Object *args;
-/* Same as run_hook_trapping_errors() but also set the hook to nil
+enum run_hooks_condition cond;
-if an error occurs. */
+};
+static Lisp_Object
+run_hook_with_args_in_buffer_trapping_problems_1 (void *puta)
+{
+struct run_hook_with_args_in_buffer_trapping_problems *porra =
+(struct run_hook_with_args_in_buffer_trapping_problems *) puta;
+return run_hook_with_args_in_buffer (porra->buf, porra->nargs, porra->args,
+				       porra->cond);
+}
+/* #### fix these functions to follow the calling convention of
+call_trapping_problems! */
 Lisp_Object
-safe_run_hook_trapping_errors (const CIntbyte *warning_string,
+run_hook_with_args_in_buffer_trapping_problems (const CIntbyte *warning_string,
-			       Lisp_Object hook_symbol,
+						struct buffer *buf, int nargs,
-			       int allow_quit)
+						Lisp_Object *args,
-{
+						enum run_hooks_condition cond,
-int speccount = specpdl_depth();
+						int flags)
-Lisp_Object tem;
+{
-Lisp_Object cons = Qnil;
+Lisp_Object sym, val, ret;
+struct run_hook_with_args_in_buffer_trapping_problems diversity_and_distrust;
 struct gcpro gcpro1;
 if (!initialized || preparing_for_armageddon)
+/* We need to bail out of here pronto. */
 return Qnil;
-tem = find_symbol_value (hook_symbol);
-if (NILP (tem) || UNBOUNDP (tem))
+GCPRO1_ARRAY (args, nargs);
-return Qnil;
+sym = args[0];
-if (!allow_quit)
+val = symbol_value_in_buffer (sym, wrap_buffer (buf));
-specbind (Qinhibit_quit, Qt);
+ret = (cond == RUN_HOOKS_UNTIL_FAILURE ? Qt : Qnil);
-cons = noseeum_cons (hook_symbol,
+if (UNBOUNDP (val) || NILP (val))
-		       warning_string ? make_opaque_ptr ((void *)warning_string)
+RETURN_UNGCPRO (ret);
-		       : Qnil);
-GCPRO1 (cons);
+diversity_and_distrust.buf = buf;
-/* Qerror not Qt, so you can get a backtrace */
+diversity_and_distrust.nargs = nargs;
-tem = condition_case_1 (Qerror,
+diversity_and_distrust.args = args;
-catch_them_squirmers_run_hook,
+diversity_and_distrust.cond = cond;
-			  hook_symbol,
-			  allow_quit ?
+RETURN_UNGCPRO
-			  allow_quit_safe_run_hook_caught_a_squirmer :
+(call_trapping_problems
-safe_run_hook_caught_a_squirmer,
+(Qerror, warning_string,
-			  cons);
+flags, 0,
-if (OPAQUE_PTRP (XCDR (cons)))
+run_hook_with_args_in_buffer_trapping_problems_1,
-free_opaque_ptr (XCDR (cons));
+&diversity_and_distrust));
-free_cons (XCONS (cons));
+}
-UNGCPRO;
+Lisp_Object
-return unbind_to_1 (speccount, tem);
+run_hook_with_args_trapping_problems (const CIntbyte *warning_string,
-}
+				      int nargs,
+				      Lisp_Object *args,
-static Lisp_Object
+				      enum run_hooks_condition cond,
-catch_them_squirmers_call0 (Lisp_Object function)
+				      int flags)
+{
+return run_hook_with_args_in_buffer_trapping_problems
+(warning_string, current_buffer, nargs, args, cond, flags);
+}
+Lisp_Object
+va_run_hook_with_args_trapping_problems (const CIntbyte *warning_string,
+					 Lisp_Object hook_var,
+					 int nargs, ...)
 {
 /* This function can GC */
-return call0 (function);
+struct gcpro gcpro1;
+int i;
+va_list vargs;
+Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs);
+int flags;
+va_start (vargs, nargs);
+funcall_args[0] = hook_var;
+for (i = 0; i < nargs; i++)
+funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
+flags = va_arg (vargs, int);
+va_end (vargs);
+GCPRO1_ARRAY (funcall_args, nargs + 1);
+RETURN_UNGCPRO (run_hook_with_args_in_buffer_trapping_problems
+		  (warning_string, current_buffer, nargs + 1, funcall_args,
+		   RUN_HOOKS_TO_COMPLETION, flags));
 }
 Lisp_Object
-call0_trapping_errors (const CIntbyte *warning_string, Lisp_Object function)
+va_run_hook_with_args_in_buffer_trapping_problems (const CIntbyte *
-{
+						   warning_string,
-int speccount;
+						   struct buffer *buf,
-Lisp_Object tem;
+						   Lisp_Object hook_var,
-Lisp_Object opaque = Qnil;
+						   int nargs, ...)
-struct gcpro gcpro1, gcpro2;
-if (SYMBOLP (function))
-{
-tem = XSYMBOL (function)->function;
-if (NILP (tem) || UNBOUNDP (tem))
-	return Qnil;
-}
-GCPRO2 (opaque, function);
-speccount = specpdl_depth();
-specbind (Qinhibit_quit, Qt);
-/* begin_gc_forbidden(); Currently no reason to do this; */
-opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
-/* Qerror not Qt, so you can get a backtrace */
-tem = condition_case_1 (Qerror,
-catch_them_squirmers_call0, function,
-caught_a_squirmer, opaque);
-if (OPAQUE_PTRP (opaque))
-free_opaque_ptr (opaque);
-UNGCPRO;
-return unbind_to_1 (speccount, tem);
-}
-static Lisp_Object
-catch_them_squirmers_call1 (Lisp_Object cons)
 {
 /* This function can GC */
-return call1 (XCAR (cons), XCDR (cons));
+struct gcpro gcpro1;
-}
+int i;
+va_list vargs;
-static Lisp_Object
+Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs);
-catch_them_squirmers_call2 (Lisp_Object cons)
+int flags;
-{
-/* This function can GC */
+va_start (vargs, nargs);
-return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons))));
+funcall_args[0] = hook_var;
-}
+for (i = 0; i < nargs; i++)
+funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
-Lisp_Object
+flags = va_arg (vargs, int);
-call1_trapping_errors (const CIntbyte *warning_string, Lisp_Object function,
+va_end (vargs);
-		       Lisp_Object object)
-{
+GCPRO1_ARRAY (funcall_args, nargs + 1);
-int speccount = specpdl_depth();
+RETURN_UNGCPRO (run_hook_with_args_in_buffer_trapping_problems
-Lisp_Object tem;
+		  (warning_string, buf, nargs + 1, funcall_args,
-Lisp_Object cons = Qnil;
+		   RUN_HOOKS_TO_COMPLETION, flags));
-Lisp_Object opaque = Qnil;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-if (SYMBOLP (function))
-{
-tem = XSYMBOL (function)->function;
-if (NILP (tem) || UNBOUNDP (tem))
-	return Qnil;
-}
-GCPRO4 (cons, opaque, function, object);
-specbind (Qinhibit_quit, Qt);
-/* begin_gc_forbidden(); Currently no reason to do this; */
-cons = noseeum_cons (function, object);
-opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
-/* Qerror not Qt, so you can get a backtrace */
-tem = condition_case_1 (Qerror,
-catch_them_squirmers_call1, cons,
-caught_a_squirmer, opaque);
-if (OPAQUE_PTRP (opaque))
-free_opaque_ptr (opaque);
-free_cons (XCONS (cons));
-UNGCPRO;
-return unbind_to_1 (speccount, tem);
-}
-Lisp_Object
-call2_trapping_errors (const CIntbyte *warning_string, Lisp_Object function,
-		       Lisp_Object object1, Lisp_Object object2)
-{
-int speccount = specpdl_depth();
-Lisp_Object tem;
-Lisp_Object cons = Qnil;
-Lisp_Object opaque = Qnil;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-if (SYMBOLP (function))
-{
-tem = XSYMBOL (function)->function;
-if (NILP (tem) || UNBOUNDP (tem))
-	return Qnil;
-}
-GCPRO5 (cons, opaque, function, object1, object2);
-specbind (Qinhibit_quit, Qt);
-/* begin_gc_forbidden(); Currently no reason to do this; */
-cons = list3 (function, object1, object2);
-opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
-/* Qerror not Qt, so you can get a backtrace */
-tem = condition_case_1 (Qerror,
-catch_them_squirmers_call2, cons,
-caught_a_squirmer, opaque);
-if (OPAQUE_PTRP (opaque))
-free_opaque_ptr (opaque);
-free_list (cons);
-UNGCPRO;
-return unbind_to_1 (speccount, tem);
 }
 /************************************************************************/
 /*		       The special binding stack			*/
 if (specpdl_size > max_specpdl_size)
 	specpdl_size = max_specpdl_size;
 }
 XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size);
 specpdl_ptr = specpdl + specpdl_depth();
+check_specbind_stack_sanity ();
 }
 /* Handle unbinding buffer-local variables */
 static Lisp_Object
 specbind_unwind_local (Lisp_Object ovalue)
 {
 Lisp_Object current = Fcurrent_buffer ();
 Lisp_Object symbol = specpdl_ptr->symbol;
-Lisp_Cons *victim = XCONS (ovalue);
+Lisp_Object victim = ovalue;
-Lisp_Object buf = get_buffer (victim->car, 0);
+Lisp_Object buf = get_buffer (XCAR (victim), 0);
-ovalue = victim->cdr;
+ovalue = XCDR (victim);
 free_cons (victim);
 if (NILP (buf))
 {
 void
 specbind (Lisp_Object symbol, Lisp_Object value)
 {
 SPECBIND (symbol, value);
+check_specbind_stack_sanity ();
 }
 void
 specbind_magic (Lisp_Object symbol, Lisp_Object value)
 {
 specpdl_ptr->symbol = symbol;
 specpdl_ptr++;
 specpdl_depth_counter++;
 Fset (symbol, value);
+check_specbind_stack_sanity ();
 }
 /* Record an unwind-protect -- FUNCTION will be called with ARG no matter
 whether a normal or non-local exit occurs. (You need to call unbind_to_1()
 before your function returns normally, passing in the integer returned
 specpdl_ptr->func = function;
 specpdl_ptr->symbol = Qnil;
 specpdl_ptr->old_value = arg;
 specpdl_ptr++;
 specpdl_depth_counter++;
+check_specbind_stack_sanity ();
 return specpdl_depth_counter - 1;
 }
 static Lisp_Object
 restore_lisp_object (Lisp_Object cons)
 {
 Lisp_Object opaque = XCAR (cons);
 Lisp_Object *addr = (Lisp_Object *) get_opaque_ptr (opaque);
 *addr = XCDR (cons);
 free_opaque_ptr (opaque);
-free_cons (XCONS (cons));
+free_cons (cons);
 return Qnil;
 }
 /* Establish an unwind-protect which will restore the Lisp_Object pointed to
 by ADDR with the value VAL. */
 free_opaque_ptr (lval);
 }
 *addr = val;
 free_opaque_ptr (opaque);
-free_cons (XCONS (cons));
+free_cons (cons);
 return Qnil;
 }
 /* Establish an unwind-protect which will restore the int pointed to
 by ADDR with the value VAL.  This function works correctly with
 caller, it is protected from garbage-protection and returned. */
 Lisp_Object
 unbind_to_1 (int count, Lisp_Object value)
 {
 UNBIND_TO_GCPRO (count, value);
+check_specbind_stack_sanity ();
 return value;
 }
 /* Don't call this directly.
 Only for use by UNBIND_TO* macros in backtrace.h */
 }
 #endif
 #endif
 }
 Vquit_flag = oquit;
+check_specbind_stack_sanity ();
 }
 /* Get the value of symbol's global binding, even if that binding is
 void
 reinit_vars_of_eval (void)
 {
 preparing_for_armageddon = 0;
 in_warnings = 0;
-Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag);
-staticpro_nodump (&Qunbound_suspended_errors_tag);
 specpdl_size = 50;
 specpdl = xnew_array (struct specbinding, specpdl_size);
 /* XEmacs change: increase these values. */
 max_specpdl_size = 3000;
 max_lisp_eval_depth = 1000;
 You can safely make it considerably larger than its default value,
 if that proves inconveniently small.
 */ );
 DEFVAR_LISP ("quit-flag", &Vquit_flag /*
-Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
+t causes running Lisp code to abort, unless `inhibit-quit' is non-nil.
-Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.
+`critical' causes running Lisp code to abort regardless of `inhibit-quit'.
+Normally, you do not need to set this value yourself.  It is set to
+t each time a Control-G is detected, and to `critical' each time a
+Shift-Control-G is detected.  The XEmacs core C code is littered with
+calls to the QUIT; macro, which check the values of `quit-flag' and
+`inhibit-quit' and abort (or more accurately, call (signal 'quit)) if
+it's correct to do so.
 */ );
 Vquit_flag = Qnil;
 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit /*
 Non-nil inhibits C-g quitting from happening immediately.
 Note that `quit-flag' will still be set by typing C-g,
 so a quit will be signalled as soon as `inhibit-quit' is nil.
 To prevent this happening, set `quit-flag' to nil
-before making `inhibit-quit' nil.  The value of `inhibit-quit' is
+before making `inhibit-quit' nil.
-ignored if a critical quit is requested by typing control-shift-G in
-an X frame.
+The value of `inhibit-quit' is ignored if a critical quit is
+requested by typing control-shift-G in a window-system frame;
+this is explained in more detail in `quit-flag'.
 */ );
 Vinhibit_quit = Qnil;
 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error /*
 *Non-nil means automatically display a backtrace buffer
 If due to `apply' or `funcall' entry, one arg, `lambda'.
 If due to `eval' entry, one arg, t.
 */ );
 Vdebugger = Qnil;
+staticpro (&Vcatch_everything_tag);
+Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0);
 staticpro (&Vpending_warnings);
 Vpending_warnings = Qnil;
 dump_add_root_object (&Vpending_warnings_tail);
 Vpending_warnings_tail = Qnil;
 staticpro (&Vautoload_queue);
 Vautoload_queue = Qnil;
 staticpro (&Vcondition_handlers);
-staticpro (&Vcurrent_warning_class);
+staticpro (&Vdeletable_permanent_display_objects);
-Vcurrent_warning_class = Qnil;
+Vdeletable_permanent_display_objects = Qnil;
-staticpro (&Vcurrent_warning_level);
+staticpro (&Vmodifiable_buffers);
-Vcurrent_warning_level = Qnil;
+Vmodifiable_buffers = Qnil;
-staticpro (&Vcurrent_error_state);
+inhibit_flags = 0;
-Vcurrent_error_state = Qnil; /* errors as normal */
+}
-}

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 853:2b6fa2618f76