annotate src/backtrace.h @ 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 a634e3b7acc8
children f3437b56874d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* The lisp stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
3 Copyright (C) 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: FSF 19.30. Contained redundantly in various C files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 in FSFmacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 FSF: Original version; a long time ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 XEmacs: split out of some C files. (For some obscure reason, a header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 file couldn't be used in FSF Emacs, but XEmacs doesn't have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 that problem.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 Mly (probably) or JWZ: Some changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
34 #ifndef INCLUDED_backtrace_h_
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
35 #define INCLUDED_backtrace_h_
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include <setjmp.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
39 #ifdef ERROR_CHECK_CATCH
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
40 /* you can use this if you are trying to debug corruption in the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
41 catchlist */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
42 void check_catchlist_sanity (void);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
43
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
44 /* you can use this if you are trying to debug corruption in the specbind
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
45 stack */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
46 void check_specbind_stack_sanity (void);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
47 #else
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
48 #define check_catchlist_sanity()
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
49 #define check_specbind_stack_sanity()
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
50 #endif
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
51
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 /* These definitions are used in eval.c and alloc.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 struct backtrace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 struct backtrace *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object *function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object *args; /* Points to vector of args. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 int nargs; /* Length of vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 If nargs is UNEVALLED, args points to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 slot holding list of unevalled args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 int pdlcount; /* specpdl_depth () when invoked */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 char evalargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 /* Nonzero means call value of debugger when done with this operation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 char debug_on_exit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 /* This structure helps implement the `catch' and `throw' control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 structure. A struct catchtag contains all the information needed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 to restore the state of the interpreter after a non-local jump.
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
71 (No information is stored concerning how to restore the state of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
72 the condition-handler list; this is handled implicitly through
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
73 an unwind-protect. unwind-protects are on the specbind stack,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
74 which is reset to its proper value by `throw'. In the process of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
75 that, any intervening bindings are reset and unwind-protects called,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
76 which fixes up the condition-handler list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 catchtag structures are chained together in the C calling stack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 the `next' member points to the next outer catchtag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 A call like (throw TAG VAL) searches for a catchtag whose `tag'
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
82 member is TAG, and then unbinds to it. A value of Vcatch_everything_tag
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
83 for the `tag' member of a catchtag is special and means "catch all throws,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
84 regardless of the tag". This is used internally by the C code. The `val'
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
85 member is used to hold VAL while the stack is unwound; `val' is returned
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
86 as the value of the catch form. The `actual_tag' member holds the value
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
87 of TAG as passed to throw, so that it can be retrieved when catches with
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
88 Vcatch_everything_tag are set up.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 All the other members are concerned with restoring the interpreter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 state. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 struct catchtag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Lisp_Object tag;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
96 /* Stores the actual tag used in `throw'; the same as TAG, unless
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
97 TAG is Vcatch_everything_tag. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
98 Lisp_Object actual_tag;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 struct catchtag *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 struct gcpro *gcpro;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 JMP_BUF jmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 struct backtrace *backlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 #if 0 /* FSFmacs */
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 440
diff changeset
105 /* FSF uses a separate handler stack to hold condition-cases,
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 440
diff changeset
106 where we use Vcondition_handlers. We should switch to their
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 440
diff changeset
107 system becaue it avoids the need to mess around with consing
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 440
diff changeset
108 up stuff and then dangerously freeing it. See comment in
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 440
diff changeset
109 condition_case_unwind(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 struct handler *handlerlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 int lisp_eval_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 int pdlcount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 /* This is the equivalent of async_timer_suppress_count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 We probably don't have to bother with this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 int poll_suppress_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 /* Dynamic-binding-o-rama */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 /* Structure for recording Lisp call stack for backtrace purposes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 /* The special binding stack holds the outer values of variables while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 they are bound by a function application or a let form, stores the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 code to be executed for Lisp unwind-protect forms, and stores the C
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 functions to be called for record_unwind_protect.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 If func is non-zero, undoing this binding applies func to old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 This implements record_unwind_protect.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 If func is zero and symbol is nil, undoing this binding evaluates
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 the list of forms in old_value; this implements Lisp's unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Otherwise, undoing this binding stores old_value as symbol's value; this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 undoes the bindings made by a let form or function call. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 struct specbinding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Lisp_Object symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Lisp_Object old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 /* #### */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 /* Everything needed to describe an active condition case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 struct handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 /* The handler clauses and variable from the condition-case form. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Lisp_Object handler;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Lisp_Object var;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 /* Fsignal stores here the condition-case clause that applies,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 and Fcondition_case thus knows which clause to run. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Lisp_Object chosen_clause;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Used to effect the longjmp() out to the handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 struct catchtag *tag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 /* The next enclosing handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 struct handler *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 extern struct handler *handlerlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 /* These are extern because GC needs to mark them */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 extern struct specbinding *specpdl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 extern struct specbinding *specpdl_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 extern struct catchtag *catchlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 extern struct backtrace *backtrace_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
174 /* Most callers should simply use specbind() and unbind_to_1(), but if
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 speed is REALLY IMPORTANT, you can use the faster macros below */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 void specbind_magic (Lisp_Object, Lisp_Object);
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
177 void grow_specpdl (EMACS_INT reserved);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 void unbind_to_hairy (int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 extern int specpdl_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* Inline version of specbind().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Use this instead of specbind() if speed is sufficiently important
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 to save the overhead of even a single function call. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 #define SPECBIND(symbol_object, value_object) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Lisp_Object SB_symbol = (symbol_object); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 Lisp_Object SB_newval = (value_object); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Lisp_Object SB_oldval; \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
188 Lisp_Symbol *SB_sym; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 SPECPDL_RESERVE (1); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 CHECK_SYMBOL (SB_symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 SB_sym = XSYMBOL (SB_symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 SB_oldval = SB_sym->value; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 { \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
198 /* #### the following test will go away when we have a constant \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 symbol magic object */ \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 if (EQ (SB_symbol, Qnil) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 EQ (SB_symbol, Qt) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 SYMBOL_IS_KEYWORD (SB_symbol)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 reject_constant_symbols (SB_symbol, SB_newval, 0, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 UNBOUNDP (SB_newval) ? \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 Qmakunbound : Qset); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 specpdl_ptr->symbol = SB_symbol; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 specpdl_ptr->old_value = SB_oldval; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 specpdl_ptr->func = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 specpdl_ptr++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 specpdl_depth_counter++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 SB_sym->value = (SB_newval); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 specbind_magic (SB_symbol, SB_newval); \
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
217 check_specbind_stack_sanity (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 /* An even faster, but less safe inline version of specbind().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Caller guarantees that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 - specpdl_depth_counter >= specpdl_size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Else we crash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 #define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object SFU_symbol = (symbol_object); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Lisp_Object SFU_newval = (value_object); \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
228 Lisp_Symbol *SFU_sym = XSYMBOL (SFU_symbol); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 Lisp_Object SFU_oldval = SFU_sym->value; \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
230 /* Most of the time, will be previously unbound. #### With a bit of \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
231 rearranging, this could be reduced to only one check. */ \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
232 if (UNBOUNDP (SFU_oldval) || !SYMBOL_VALUE_MAGIC_P (SFU_oldval)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 specpdl_ptr->symbol = SFU_symbol; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 specpdl_ptr->old_value = SFU_oldval; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 specpdl_ptr->func = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 specpdl_ptr++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 specpdl_depth_counter++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 SFU_sym->value = (SFU_newval); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 specbind_magic (SFU_symbol, SFU_newval); \
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
244 check_specbind_stack_sanity (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 /* Request enough room for SIZE future entries on special binding stack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 #define SPECPDL_RESERVE(size) do { \
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
248 EMACS_INT SR_size = (size); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (specpdl_depth() + SR_size >= specpdl_size) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 grow_specpdl (SR_size); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
253 /* Inline version of unbind_to_1().
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
254 [[Use this instead of unbind_to_1() if speed is sufficiently important
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
255 to save the overhead of even a single function call.]]
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
256 This is bogus pseudo-optimization. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
258 Most of the time, unbind_to_1() is called only on ordinary
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 variables, so optimize for that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 #define UNBIND_TO_GCPRO(count, value) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 int UNBIND_TO_count = (count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 while (specpdl_depth_counter != UNBIND_TO_count) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 { \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
264 Lisp_Symbol *sym; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 --specpdl_ptr; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 --specpdl_depth_counter; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 if (specpdl_ptr->func != 0 || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ((sym = XSYMBOL (specpdl_ptr->symbol)), \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 SYMBOL_VALUE_MAGIC_P (sym->value))) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 struct gcpro gcpro1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 GCPRO1 (value); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 unbind_to_hairy (UNBIND_TO_count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 UNGCPRO; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 break; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 sym->value = specpdl_ptr->old_value; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 } \
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
281 check_specbind_stack_sanity (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
284 /* A slightly faster inline version of unbind_to_1,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 that doesn't offer GCPROing services. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 #define UNBIND_TO(count) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 int UNBIND_TO_count = (count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 while (specpdl_depth_counter != UNBIND_TO_count) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 { \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
290 Lisp_Symbol *sym; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 --specpdl_ptr; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 --specpdl_depth_counter; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 if (specpdl_ptr->func != 0 || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 ((sym = XSYMBOL (specpdl_ptr->symbol)), \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 SYMBOL_VALUE_MAGIC_P (sym->value))) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 unbind_to_hairy (UNBIND_TO_count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 break; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 sym->value = specpdl_ptr->old_value; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 } \
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
304 check_specbind_stack_sanity (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 /* Unused. It's too hard to guarantee that the current bindings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 contain only variables. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 647
diff changeset
310 /* Another inline version of unbind_to_1(). VALUE is GC-protected.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 Caller guarantees that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 - all of the elements on the binding stack are variable bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 Else we crash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 #define UNBIND_TO_GCPRO_VARIABLES_ONLY(count, value) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 int UNBIND_TO_count = (count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 while (specpdl_depth_counter != UNBIND_TO_count) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 { \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
318 Lisp_Symbol *sym; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 --specpdl_ptr; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 --specpdl_depth_counter; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 sym = XSYMBOL (specpdl_ptr->symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 if (!SYMBOL_VALUE_MAGIC_P (sym->value)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 sym->value = specpdl_ptr->old_value; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 struct gcpro gcpro1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 GCPRO1 (value); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 unbind_to_hairy (UNBIND_TO_count); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 UNGCPRO; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 break; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 /* A faster, but less safe inline version of Fset().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 Caller guarantees that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 Else we crash. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 #define FSET_FAST_UNSAFE(sym, newval) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 Lisp_Object FFU_sym = (sym); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 Lisp_Object FFU_newval = (newval); \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
344 Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 Lisp_Object FFU_oldval = FFU_symbol->value; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 FFU_symbol->value = FFU_newval; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 Fset (FFU_sym, FFU_newval); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
352 #endif /* INCLUDED_backtrace_h_ */