1 /* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
3 Copyright (C) 2000 Ben Wing.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Not in FSF. */
23 /* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
24 * and does weird magic stuff if so */
26 #ifndef INCLUDED_symeval_h_
27 #define INCLUDED_symeval_h_
29 enum symbol_value_type {
30 /* The following tags use the 'symbol_value_forward' structure
31 and are strictly for variables DEFVARed on the C level. */
32 SYMVAL_FIXNUM_FORWARD, /* Forward C "Fixnum", really "EMACS_INT" */
33 SYMVAL_CONST_FIXNUM_FORWARD, /* Same, but can't be set */
34 SYMVAL_BOOLEAN_FORWARD, /* Forward C boolean ("int") */
35 SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */
36 SYMVAL_OBJECT_FORWARD, /* Forward C Lisp_Object */
37 SYMVAL_CONST_OBJECT_FORWARD, /* Same, but can't be set */
38 SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives a
39 different message when attempting to
40 set that says "use set-specifier" */
41 SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into Vbuffer_defaults */
42 SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into current_buffer */
43 SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into
44 current_buffer, can't be set */
45 SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into
47 SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
49 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
52 SYMVAL_UNBOUND_MARKER, /* Only Qunbound actually has this tag */
54 /* The following tags use the 'symbol_value_buffer_local' structure */
55 SYMVAL_BUFFER_LOCAL, /* make-variable-buffer-local */
56 SYMVAL_SOME_BUFFER_LOCAL, /* make-local-variable */
58 /* The following tag uses the 'symbol_value_lisp_magic' structure */
59 SYMVAL_LISP_MAGIC, /* Forward to lisp callbacks */
61 /* The following tag uses the 'symbol_value_varalias' structure */
62 SYMVAL_VARALIAS /* defvaralias */
65 SYMVAL_CONSTANT_SYMBOL, /* Self-evaluating symbol */
70 /* Underlying C type used to implement DEFVAR_INT */
71 typedef EMACS_INT Fixnum;
73 struct symbol_value_magic {
74 struct lcrecord_header lcheader;
76 enum symbol_value_type type;
78 #define SYMBOL_VALUE_MAGIC_P(x) \
80 XRECORD_LHEADER (x)->type <= lrecord_type_max_symbol_value_magic)
81 #define XSYMBOL_VALUE_MAGIC_TYPE(v) \
82 (((struct symbol_value_magic *) XPNTR (v))->type)
83 #define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, p)
84 void print_symbol_value_magic(Lisp_Object, Lisp_Object, int);
86 /********** The various different symbol-value-magic types ***********/
88 /* 1. symbol-value-forward */
90 /* This type of symbol-value-magic is used for variables declared
91 DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
92 DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.
94 Note that some of these types of variables can be made buffer-local.
95 Then, the symbol's value field contains a symbol-value-buffer-local,
96 whose CURRENT-VALUE field then contains a symbol-value-forward.
99 struct symbol_value_forward {
100 struct symbol_value_magic magic;
102 /* `magicfun' is a function controlling the magic behavior of this
105 SYM is the symbol being operated on (read, set, etc.);
107 VAL is either the value to set or the value to be returned.
109 IN_OBJECT is the buffer or console that the value is read in
110 or set in. A value of Qnil means that the current buffer
111 and possibly other buffers are being set. (This value will
112 never be passed for built-in buffer-local or console-local
113 variables such as `truncate-lines'.) (Currently, a value of
114 Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
115 DEFVAR_BOOL variables; the code isn't smart enough to figure
116 out what buffers besides the current buffer are being
117 affected. Because the magic function is called
118 before the value is changed, it's not that easy
119 to determine which buffers are getting changed.
120 #### If this information is important, let me know
121 and I will look into providing it.) (Remember also
122 that the only console-local variables currently existing
123 are built-in ones, because others can't be created.)
125 FLAGS gives more information about the operation being performed.
127 The return value indicates what the magic function actually did.
129 Currently FLAGS and the return value are not used. This
130 function is only called when the value of a forward variable
131 is about to be changed. Note that this can occur explicitly
132 through a call to `set', `setq', `set-default', or `setq-default',
133 or implicitly by the current buffer being changed. */
134 int (*magicfun) (Lisp_Object sym, Lisp_Object * val,
135 Lisp_Object in_object, int flags);
137 DECLARE_LRECORD(symbol_value_forward, struct symbol_value_forward);
138 #define XSYMBOL_VALUE_FORWARD(x) \
139 XRECORD (x, symbol_value_forward, struct symbol_value_forward)
140 #define symbol_value_forward_forward(m) ((void *)((m)->magic.value))
141 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
143 /* 2. symbol-value-buffer-local */
145 struct symbol_value_buffer_local {
146 struct symbol_value_magic magic;
147 /* Used in a symbol value cell when the symbol's value is per-buffer.
149 The type of the symbol-value-magic will be either
150 SYMVAL_BUFFER_LOCAL (i.e. `make-variable-buffer-local' was called)
151 or SYMVAL_SOME_BUFFER_LOCAL (i.e. `make-local-variable' was called).
152 The only difference between the two is that when setting the
153 former kind of variable, an implicit `make-local-variable' is
156 A buffer-local variable logically has
159 -- local values in some buffers
161 The primary place where the local values are stored is in each
162 buffer's local_var_alist slot.
164 In the simplest implementation, all that this structure needs to
165 keep track of is the default value; to retrieve the value in
166 a buffer, look in that buffer's local_var_alist, and use the
167 default value if there is no local value. To implement
168 `make-local-variable' in a buffer, look in the buffer's
169 local_var_alist, and if no element exists for this symbol,
170 add one, copying the value from the default value. When setting
171 the value in a buffer, look in the buffer's local_var_alist, and set
172 the value in that list if an element exists for this symbol;
173 otherwise, set the default. (Remember that SYMVAL_BUFFER_LOCAL
174 variables implicitly call `make-local-variable' first, so when
175 setting a value, there will always be an entry in the buffer's
176 local_var_alist to set.)
178 However, this operation is potentially slow. To speed it up,
179 we cache the value in one buffer in this structure.
181 NOTE: This is *not* a write-through cache. I.e. when setting
182 the value in the buffer that is cached, we *only* change the
183 cache and don't write the value through to either the buffer's
184 local_var_alist or the default value. Therefore, when retrieving
185 a value in a buffer, you must *always* look in the cache to see if
186 it refers to that buffer.
188 The cache consists of
190 -- a buffer, or nil if the cache has not been set up
191 -- the value in that buffer
192 -- the element (a cons) from the buffer's local_var_alist, or
193 nil if there is no local value in the buffer
195 These slots are called CURRENT-BUFFER, CURRENT-VALUE, and
196 CURRENT-ALIST-ELEMENT, respectively.
198 If we want to examine or set the value in BUFFER and CURRENT-BUFFER
199 equals BUFFER, we just examine or set CURRENT-VALUE. Otherwise,
200 we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe
201 into DEFAULT-VALUE), then find the appropriate alist element for
202 BUFFER and set up CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE
203 out of that element (or maybe out of DEFAULT-VALUE), and store
204 BUFFER into CURRENT-BUFFER.
206 If we are setting the variable and the current buffer does not have
207 an alist entry for this variable, an alist entry is created.
209 Note that CURRENT-BUFFER's local_var_alist value for this variable
210 might be out-of-date (the correct value is stored in CURRENT-VALUE).
211 Similarly, if CURRENT-BUFFER sees the default value, then
212 DEFAULT-VALUE might be out-of-date.
214 Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
215 forwarding pointer. Each time it is examined or set,
216 forwarding must be done.
218 Lisp_Object default_value;
219 Lisp_Object current_value;
220 Lisp_Object current_buffer;
221 Lisp_Object current_alist_element;
223 DECLARE_LRECORD(symbol_value_buffer_local, struct symbol_value_buffer_local);
224 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
225 XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
226 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
228 /* 3. symbol-value-lisp-magic */
230 enum lisp_magic_handler {
231 MAGIC_HANDLER_GET_VALUE,
232 MAGIC_HANDLER_SET_VALUE,
233 MAGIC_HANDLER_BOUND_PREDICATE,
234 MAGIC_HANDLER_MAKE_UNBOUND,
235 MAGIC_HANDLER_LOCAL_PREDICATE,
236 MAGIC_HANDLER_MAKE_LOCAL,
240 struct symbol_value_lisp_magic {
241 struct symbol_value_magic magic;
242 Lisp_Object handler[MAGIC_HANDLER_MAX];
243 Lisp_Object harg[MAGIC_HANDLER_MAX];
244 Lisp_Object shadowed;
246 DECLARE_LRECORD(symbol_value_lisp_magic, struct symbol_value_lisp_magic);
247 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
248 XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
249 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
251 /* 4. symbol-value-varalias */
253 struct symbol_value_varalias {
254 struct symbol_value_magic magic;
256 Lisp_Object shadowed;
258 DECLARE_LRECORD(symbol_value_varalias, struct symbol_value_varalias);
259 #define XSYMBOL_VALUE_VARALIAS(x) \
260 XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
261 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
262 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
263 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
265 /* To define a Lisp primitive function using a C function `Fname', do this:
266 DEFUN ("name, Fname, ...); // at top level in foo.c
267 DEFSUBR (Fname); // in syms_of_foo();
269 void defsubr(Lisp_Subr *);
270 #define DEFSUBR(Fname) defsubr (&S##Fname)
273 void undefsubr(Lisp_Subr*);
274 #define UNDEFSUBR(Fname) undefsubr(&S##Fname)
276 /* To define a Lisp primitive macro using a C function `Fname', do this:
277 DEFUN ("name, Fname, ...); // at top level in foo.c
278 DEFSUBR_MACRO (Fname); // in syms_of_foo();
280 void defsubr_macro(Lisp_Subr *);
281 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
283 /* Macros for calling subrs with an argument list whose length is only
284 known at runtime. See EXFUN and DEFUN for similar hackery. */
287 #define AV_1(av) av[0]
288 #define AV_2(av) AV_1(av), av[1]
289 #define AV_3(av) AV_2(av), av[2]
290 #define AV_4(av) AV_3(av), av[3]
291 #define AV_5(av) AV_4(av), av[4]
292 #define AV_6(av) AV_5(av), av[5]
293 #define AV_7(av) AV_6(av), av[6]
294 #define AV_8(av) AV_7(av), av[7]
296 #define PRIMITIVE_FUNCALL_1(fn, av, ac) \
297 (((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av)))
299 /* If subrs take more than 8 arguments, more cases need to be added
300 to this switch. (But wait - don't do it - if you really need
301 a SUBR with more than 8 arguments, use max_args == MANY.
302 See the DEFUN macro in lisp.h) */
303 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \
304 void (*PF_fn)(void) = (void (*)(void)) fn; \
305 Lisp_Object *PF_av = (av); \
308 default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \
309 case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \
310 case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \
311 case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \
312 case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break; \
313 case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break; \
314 case 6: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 6); break; \
315 case 7: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 7); break; \
316 case 8: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 8); break; \
320 #define FUNCALL_SUBR(rv, subr, av, ac) \
321 PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac);
323 void defsymbol_massage_name(Lisp_Object * location, const char *name);
324 void defsymbol_massage_name_nodump(Lisp_Object * location, const char *name);
325 void defsymbol_massage_multiword_predicate(Lisp_Object * location,
327 void defsymbol_massage_multiword_predicate_nodump(Lisp_Object * location,
329 void defsymbol(Lisp_Object * location, char *name);
330 void defsymbol_nodump(Lisp_Object * location, char *name);
332 #define DEFSYMBOL(name) defsymbol_massage_name (&name, #name)
333 #define DEFSYMBOL_NO_DUMP(name) defsymbol_massage_name_nodump (&name, #name)
334 #define DEFSYMBOL_MULTIWORD_PREDICATE(name) \
335 defsymbol_massage_multiword_predicate (&name, #name)
336 #define DEFSYMBOL_MULTIWORD_PREDICATE_NO_DUMP(name) \
337 defsymbol_massage_multiword_predicate_nodump (&name, #name)
339 void defkeyword(Lisp_Object * location, char *name);
340 void defkeyword_massage_name(Lisp_Object * location, const char *name);
341 #define DEFKEYWORD(name) defkeyword_massage_name (&name, #name)
343 void deferror(Lisp_Object * symbol, char *name,
344 const char *message, Lisp_Object inherits_from);
345 void deferror_massage_name(Lisp_Object * symbol, char *name,
346 const char *message, Lisp_Object inherits_from);
347 void deferror_massage_name_and_message(Lisp_Object * symbol, char *name,
348 Lisp_Object inherits_from);
349 #define DEFERROR(name, message, inherits_from) \
350 deferror_massage_name (&name, #name, message, inherits_from)
351 /* In this case, the error message is the same as the name, modulo some
353 #define DEFERROR_STANDARD(name, inherits_from) \
354 deferror_massage_name_and_message (&name, #name, inherits_from)
356 /* Macros we use to define forwarded Lisp variables.
357 These are used in the syms_of_FILENAME functions. */
359 void defvar_magic(char *symbol_name, const struct symbol_value_forward *magic);
361 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
362 # define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do { \
363 static const struct symbol_value_forward I_hate_C = \
364 { /* struct symbol_value_forward */ \
365 { /* struct symbol_value_magic */ \
366 { /* struct lcrecord_header */ \
367 { /* struct lrecord_header */ \
368 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
370 1, /* c_readonly bit */ \
371 1 /* lisp_readonly bit */ \
381 defvar_magic ((lname), &I_hate_C); \
386 # define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do { \
387 static const struct symbol_value_forward I_hate_C = \
388 { /* struct symbol_value_forward */ \
389 { /* struct symbol_value_magic */ \
390 { /* struct lcrecord_header */ \
391 { /* struct lrecord_header */ \
392 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
394 1, /* c_readonly bit */ \
395 1 /* lisp_readonly bit */ \
406 defvar_magic ((lname), &I_hate_C); \
410 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{ \
411 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
412 dump_add_opaque_int (c_location); \
415 #define DEFVAR_SYMVAL_FWD_FIXNUM(lname, c_location, forward_type, magicfun) do{ \
416 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
417 dump_add_opaque_fixnum (c_location); \
420 #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \
421 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
423 Lisp_Object *DSF_location = c_location; /* Type check */ \
424 staticpro (DSF_location); \
425 if (EQ (*DSF_location, Qnull_pointer)) *DSF_location = Qnil; \
429 #define DEFVAR_LISP(lname, c_location) \
430 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
431 #define DEFVAR_CONST_LISP(lname, c_location) \
432 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
433 #define DEFVAR_SPECIFIER(lname, c_location) \
434 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
435 #define DEFVAR_INT(lname, c_location) \
436 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
437 #define DEFVAR_CONST_INT(lname, c_location) \
438 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
439 #define DEFVAR_BOOL(lname, c_location) \
440 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
441 #define DEFVAR_CONST_BOOL(lname, c_location) \
442 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
443 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
444 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun)
445 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
446 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun)
447 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
448 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
450 void flush_all_buffer_local_cache(void);
452 #endif /* INCLUDED_symeval_h_ */