]> code.delx.au - gnu-emacs/blob - src/lisp.h
Remove P_ and __P macros.
[gnu-emacs] / src / lisp.h
1 /* Fundamental definitions for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #ifndef EMACS_LISP_H
22 #define EMACS_LISP_H
23
24 /* Declare the prototype for a general external function. */
25 #define P_(proto) proto
26
27 /* Use the configure flag --enable-checking[=LIST] to enable various
28 types of run time checks for Lisp objects. */
29
30 #ifdef GC_CHECK_CONS_LIST
31 #define CHECK_CONS_LIST() check_cons_list()
32 #else
33 #define CHECK_CONS_LIST() ((void)0)
34 #endif
35
36 /* These are default choices for the types to use. */
37 #ifdef _LP64
38 #ifndef EMACS_INT
39 #define EMACS_INT long
40 #define BITS_PER_EMACS_INT BITS_PER_LONG
41 #endif
42 #ifndef EMACS_UINT
43 #define EMACS_UINT unsigned long
44 #endif
45 #else /* not _LP64 */
46 #ifndef EMACS_INT
47 #define EMACS_INT int
48 #define BITS_PER_EMACS_INT BITS_PER_INT
49 #endif
50 #ifndef EMACS_UINT
51 #define EMACS_UINT unsigned int
52 #endif
53 #endif
54
55 /* Extra internal type checking? */
56 extern int suppress_checking;
57 extern void die (const char *, const char *, int) NO_RETURN;
58
59 #ifdef ENABLE_CHECKING
60
61 /* The suppress_checking variable is initialized to 0 in alloc.c. Set
62 it to 1 using a debugger to temporarily disable aborting on
63 detected internal inconsistencies or error conditions.
64
65 Testing suppress_checking after the supplied condition ensures that
66 the side effects produced by CHECK will be consistent, independent
67 of whether ENABLE_CHECKING is defined, or whether the checks are
68 suppressed at run time.
69
70 In some cases, a good compiler may be able to optimize away the
71 CHECK macro altogether, e.g., if XSTRING (x) uses CHECK to test
72 STRINGP (x), but a particular use of XSTRING is invoked only after
73 testing that STRINGP (x) is true, making the test redundant. */
74
75 #define CHECK(check,msg) (((check) || suppress_checking \
76 ? (void) 0 \
77 : die ((msg), __FILE__, __LINE__)), \
78 0)
79 #else
80
81 /* Produce same side effects and result, but don't complain. */
82 #define CHECK(check,msg) ((check),0)
83
84 #endif
85
86 /* Define an Emacs version of "assert", since some system ones are
87 flaky. */
88 #ifndef ENABLE_CHECKING
89 #define eassert(X) (void) 0
90 #else /* ENABLE_CHECKING */
91 #if defined (__GNUC__) && __GNUC__ >= 2 && defined (__STDC__)
92 #define eassert(cond) CHECK(cond,"assertion failed: " #cond)
93 #else
94 #define eassert(cond) CHECK(cond,"assertion failed")
95 #endif
96 #endif /* ENABLE_CHECKING */
97 \f
98 /* Use the configure flag --enable-use-lisp-union-type to make
99 Lisp_Object use a union type instead of the default int. The flag
100 causes USE_LISP_UNION_TYPE to be defined. */
101
102 /***** Select the tagging scheme. *****/
103 /* There are basically two options that control the tagging scheme:
104 - USE_LISP_UNION_TYPE says that Lisp_Object should be a union instead
105 of an integer.
106 - USE_LSB_TAG means that we can assume the least 3 bits of pointers are
107 always 0, and we can thus use them to hold tag bits, without
108 restricting our addressing space.
109
110 If USE_LSB_TAG is not set, then we use the top 3 bits for tagging, thus
111 restricting our possible address range. Currently USE_LSB_TAG is not
112 allowed together with a union. This is not due to any fundamental
113 technical (or political ;-) problem: nobody wrote the code to do it yet.
114
115 USE_LSB_TAG not only requires the least 3 bits of pointers returned by
116 malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
117 on the few static Lisp_Objects used: all the defsubr as well
118 as the two special buffers buffer_defaults and buffer_local_symbols. */
119
120 /* First, try and define DECL_ALIGN(type,var) which declares a static
121 variable VAR of type TYPE with the added requirement that it be
122 TYPEBITS-aligned. */
123 #ifndef NO_DECL_ALIGN
124 # ifndef DECL_ALIGN
125 /* What compiler directive should we use for non-gcc compilers? -stef */
126 # if defined (__GNUC__)
127 # define DECL_ALIGN(type, var) \
128 type __attribute__ ((__aligned__ (1 << GCTYPEBITS))) var
129 # endif
130 # endif
131 #endif
132
133 /* Let's USE_LSB_TAG on systems where we know malloc returns mult-of-8. */
134 #if defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ || defined DARWIN_OS
135 /* We also need to be able to specify mult-of-8 alignment on static vars. */
136 # if defined DECL_ALIGN
137 # define USE_LSB_TAG
138 # endif
139 #endif
140
141 /* If we cannot use 8-byte alignment, make DECL_ALIGN a no-op. */
142 #ifndef DECL_ALIGN
143 # ifdef USE_LSB_TAG
144 # error "USE_LSB_TAG used without defining DECL_ALIGN"
145 # endif
146 # define DECL_ALIGN(type, var) type var
147 #endif
148
149
150 /* Define the fundamental Lisp data structures. */
151
152 /* If USE_2_TAGBITS_FOR_INTS is defined, then Lisp integers use
153 2 tags, to give them one extra bit, thus extending their range from
154 e.g -2^28..2^28-1 to -2^29..2^29-1. */
155 #define USE_2_TAGS_FOR_INTS
156
157 /* Making it work for the union case is too much trouble. */
158 #ifdef USE_LISP_UNION_TYPE
159 # undef USE_2_TAGS_FOR_INTS
160 #endif
161
162 /* This is the set of Lisp data types. */
163
164 #if !defined USE_2_TAGS_FOR_INTS
165 # define LISP_INT_TAG Lisp_Int
166 # define case_Lisp_Int case Lisp_Int
167 # define LISP_STRING_TAG 4
168 # define LISP_INT_TAG_P(x) ((x) == Lisp_Int)
169 #else
170 # define LISP_INT_TAG Lisp_Int0
171 # define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
172 # ifdef USE_LSB_TAG
173 # define LISP_INT1_TAG 4
174 # define LISP_STRING_TAG 1
175 # define LISP_INT_TAG_P(x) (((x) & 3) == 0)
176 # else
177 # define LISP_INT1_TAG 1
178 # define LISP_STRING_TAG 4
179 # define LISP_INT_TAG_P(x) (((x) & 6) == 0)
180 # endif
181 #endif
182
183 enum Lisp_Type
184 {
185 /* Integer. XINT (obj) is the integer value. */
186 #ifdef USE_2_TAGS_FOR_INTS
187 Lisp_Int0 = 0,
188 Lisp_Int1 = LISP_INT1_TAG,
189 #else
190 Lisp_Int = 0,
191 #endif
192
193 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
194 Lisp_Symbol = 2,
195
196 /* Miscellaneous. XMISC (object) points to a union Lisp_Misc,
197 whose first member indicates the subtype. */
198 Lisp_Misc = 3,
199
200 /* String. XSTRING (object) points to a struct Lisp_String.
201 The length of the string, and its contents, are stored therein. */
202 Lisp_String = LISP_STRING_TAG,
203
204 /* Vector of Lisp objects, or something resembling it.
205 XVECTOR (object) points to a struct Lisp_Vector, which contains
206 the size and contents. The size field also contains the type
207 information, if it's not a real vector object. */
208 Lisp_Vectorlike = 5,
209
210 /* Cons. XCONS (object) points to a struct Lisp_Cons. */
211 Lisp_Cons = 6,
212
213 Lisp_Float = 7,
214 };
215
216 /* This is the set of data types that share a common structure.
217 The first member of the structure is a type code from this set.
218 The enum values are arbitrary, but we'll use large numbers to make it
219 more likely that we'll spot the error if a random word in memory is
220 mistakenly interpreted as a Lisp_Misc. */
221 enum Lisp_Misc_Type
222 {
223 Lisp_Misc_Free = 0x5eab,
224 Lisp_Misc_Marker,
225 Lisp_Misc_Overlay,
226 Lisp_Misc_Save_Value,
227 /* Currently floats are not a misc type,
228 but let's define this in case we want to change that. */
229 Lisp_Misc_Float,
230 /* This is not a type code. It is for range checking. */
231 Lisp_Misc_Limit
232 };
233
234 /* These are the types of forwarding objects used in the value slot
235 of symbols for special built-in variables whose value is stored in
236 C variables. */
237 enum Lisp_Fwd_Type
238 {
239 Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
240 Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
241 Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
242 Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
243 Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
244 };
245
246 #ifndef GCTYPEBITS
247 #define GCTYPEBITS 3
248 #endif
249
250 /* These values are overridden by the m- file on some machines. */
251 #ifndef VALBITS
252 #define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS)
253 #endif
254
255 #ifdef USE_LISP_UNION_TYPE
256
257 #ifndef WORDS_BIG_ENDIAN
258
259 /* Definition of Lisp_Object for little-endian machines. */
260
261 typedef
262 union Lisp_Object
263 {
264 /* Used for comparing two Lisp_Objects;
265 also, positive integers can be accessed fast this way. */
266 EMACS_UINT i;
267
268 struct
269 {
270 EMACS_INT val : VALBITS;
271 enum Lisp_Type type : GCTYPEBITS;
272 } s;
273 struct
274 {
275 EMACS_UINT val : VALBITS;
276 enum Lisp_Type type : GCTYPEBITS;
277 } u;
278 }
279 Lisp_Object;
280
281 #else /* If WORDS_BIG_ENDIAN */
282
283 typedef
284 union Lisp_Object
285 {
286 /* Used for comparing two Lisp_Objects;
287 also, positive integers can be accessed fast this way. */
288 EMACS_UINT i;
289
290 struct
291 {
292 enum Lisp_Type type : GCTYPEBITS;
293 EMACS_INT val : VALBITS;
294 } s;
295 struct
296 {
297 enum Lisp_Type type : GCTYPEBITS;
298 EMACS_UINT val : VALBITS;
299 } u;
300 }
301 Lisp_Object;
302
303 #endif /* WORDS_BIG_ENDIAN */
304
305 #ifdef __GNUC__
306 static __inline__ Lisp_Object
307 LISP_MAKE_RVALUE (Lisp_Object o)
308 {
309 return o;
310 }
311 #else
312 /* This is more portable to pre-C99 non-GCC compilers, but for
313 backwards compatibility GCC still accepts an old GNU extension
314 which caused this to only generate a warning. */
315 #define LISP_MAKE_RVALUE(o) (0 ? (o) : (o))
316 #endif
317
318 #else /* USE_LISP_UNION_TYPE */
319
320 /* If union type is not wanted, define Lisp_Object as just a number. */
321
322 typedef EMACS_INT Lisp_Object;
323 #define LISP_MAKE_RVALUE(o) (0+(o))
324 #endif /* USE_LISP_UNION_TYPE */
325
326 /* In the size word of a vector, this bit means the vector has been marked. */
327
328 #define ARRAY_MARK_FLAG ((EMACS_UINT) 1 << (BITS_PER_EMACS_INT - 1))
329
330 /* In the size word of a struct Lisp_Vector, this bit means it's really
331 some other vector-like object. */
332 #define PSEUDOVECTOR_FLAG ((ARRAY_MARK_FLAG >> 1))
333
334 /* In a pseudovector, the size field actually contains a word with one
335 PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to
336 indicate the actual type.
337 We use a bitset, even tho only one of the bits can be set at any
338 particular time just so as to be able to use micro-optimizations such as
339 testing membership of a particular subset of pseudovectors in Fequal.
340 It is not crucial, but there are plenty of bits here, so why not do it? */
341 enum pvec_type
342 {
343 PVEC_NORMAL_VECTOR = 0,
344 PVEC_PROCESS = 0x200,
345 PVEC_FRAME = 0x400,
346 PVEC_COMPILED = 0x800,
347 PVEC_WINDOW = 0x1000,
348 PVEC_WINDOW_CONFIGURATION = 0x2000,
349 PVEC_SUBR = 0x4000,
350 PVEC_CHAR_TABLE = 0x8000,
351 PVEC_BOOL_VECTOR = 0x10000,
352 PVEC_BUFFER = 0x20000,
353 PVEC_HASH_TABLE = 0x40000,
354 PVEC_TERMINAL = 0x80000,
355 PVEC_SUB_CHAR_TABLE = 0x100000,
356 PVEC_FONT = 0x200000,
357 PVEC_OTHER = 0x400000,
358 PVEC_TYPE_MASK = 0x7ffe00
359
360 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
361 GDB. It doesn't work on OS Alpha. Moved to a variable in
362 emacs.c. */
363 PVEC_FLAG = PSEUDOVECTOR_FLAG
364 #endif
365 };
366
367 /* For convenience, we also store the number of elements in these bits.
368 Note that this size is not necessarily the memory-footprint size, but
369 only the number of Lisp_Object fields (that need to be traced by the GC).
370 The distinction is used e.g. by Lisp_Process which places extra
371 non-Lisp_Object fields at the end of the structure. */
372 #define PSEUDOVECTOR_SIZE_MASK 0x1ff
373
374 /* Number of bits to put in each character in the internal representation
375 of bool vectors. This should not vary across implementations. */
376 #define BOOL_VECTOR_BITS_PER_CHAR 8
377 \f
378 /* These macros extract various sorts of values from a Lisp_Object.
379 For example, if tem is a Lisp_Object whose type is Lisp_Cons,
380 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
381
382 #ifndef USE_LISP_UNION_TYPE
383
384 /* Return a perfect hash of the Lisp_Object representation. */
385 #define XHASH(a) (a)
386
387 #ifdef USE_LSB_TAG
388
389 #define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
390 #define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) & TYPEMASK))
391 #ifdef USE_2_TAGS_FOR_INTS
392 # define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1))
393 # define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1))
394 # define make_number(N) (((EMACS_INT) (N)) << (GCTYPEBITS - 1))
395 #else
396 # define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS)
397 # define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
398 # define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
399 #endif
400 #define XSET(var, type, ptr) \
401 (eassert (XTYPE (ptr) == 0), /* Check alignment. */ \
402 (var) = ((EMACS_INT) (type)) | ((EMACS_INT) (ptr)))
403
404 #define XPNTR(a) ((EMACS_INT) ((a) & ~TYPEMASK))
405
406 #else /* not USE_LSB_TAG */
407
408 #define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1)
409
410 /* One need to override this if there must be high bits set in data space
411 (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work
412 on all machines, but would penalize machines which don't need it)
413 */
414 #define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) >> VALBITS))
415
416 /* For integers known to be positive, XFASTINT provides fast retrieval
417 and XSETFASTINT provides fast storage. This takes advantage of the
418 fact that Lisp_Int is 0. */
419 #define XFASTINT(a) ((a) + 0)
420 #define XSETFASTINT(a, b) ((a) = (b))
421
422 /* Extract the value of a Lisp_Object as a (un)signed integer. */
423
424 #ifdef USE_2_TAGS_FOR_INTS
425 # define XINT(a) ((((EMACS_INT) (a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1))
426 # define XUINT(a) ((EMACS_UINT) ((a) & (1 + (VALMASK << 1))))
427 # define make_number(N) ((((EMACS_INT) (N)) & (1 + (VALMASK << 1))))
428 #else
429 # define XINT(a) ((((EMACS_INT) (a)) << (BITS_PER_EMACS_INT - VALBITS)) \
430 >> (BITS_PER_EMACS_INT - VALBITS))
431 # define XUINT(a) ((EMACS_UINT) ((a) & VALMASK))
432 # define make_number(N) \
433 ((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
434 #endif
435
436 #define XSET(var, type, ptr) \
437 ((var) = ((EMACS_INT)(type) << VALBITS) + ((EMACS_INT) (ptr) & VALMASK))
438
439 #define XPNTR(a) ((EMACS_UINT) ((a) & VALMASK))
440
441 #endif /* not USE_LSB_TAG */
442
443 #else /* USE_LISP_UNION_TYPE */
444
445 #ifdef USE_2_TAGS_FOR_INTS
446 # error "USE_2_TAGS_FOR_INTS is not supported with USE_LISP_UNION_TYPE"
447 #endif
448
449 #define XHASH(a) ((a).i)
450
451 #define XTYPE(a) ((enum Lisp_Type) (a).u.type)
452
453 #ifdef EXPLICIT_SIGN_EXTEND
454 /* Make sure we sign-extend; compilers have been known to fail to do so.
455 We additionally cast to EMACS_INT since it seems that some compilers
456 have been known to fail to do so, even though the bitfield is declared
457 as EMACS_INT already. */
458 #define XINT(a) ((((EMACS_INT) (a).s.val) << (BITS_PER_EMACS_INT - VALBITS)) \
459 >> (BITS_PER_EMACS_INT - VALBITS))
460 #else
461 #define XINT(a) ((a).s.val)
462 #endif /* EXPLICIT_SIGN_EXTEND */
463
464 #define XUINT(a) ((a).u.val)
465
466 #ifdef USE_LSB_TAG
467
468 # define XSET(var, vartype, ptr) \
469 (eassert ((((EMACS_UINT) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \
470 (var).u.val = ((EMACS_UINT) (ptr)) >> GCTYPEBITS, \
471 (var).u.type = ((char) (vartype)))
472
473 /* Some versions of gcc seem to consider the bitfield width when issuing
474 the "cast to pointer from integer of different size" warning, so the
475 cast is here to widen the value back to its natural size. */
476 # define XPNTR(v) ((EMACS_INT)((v).s.val) << GCTYPEBITS)
477
478 #else /* !USE_LSB_TAG */
479
480 /* For integers known to be positive, XFASTINT provides fast retrieval
481 and XSETFASTINT provides fast storage. This takes advantage of the
482 fact that Lisp_Int is 0. */
483 # define XFASTINT(a) ((a).i + 0)
484 # define XSETFASTINT(a, b) ((a).i = (b))
485
486 # define XSET(var, vartype, ptr) \
487 (((var).s.val = ((EMACS_INT) (ptr))), ((var).s.type = ((char) (vartype))))
488
489 #endif /* !USE_LSB_TAG */
490
491 #if __GNUC__ >= 2 && defined (__OPTIMIZE__)
492 #define make_number(N) \
493 (__extension__ ({ Lisp_Object _l; _l.s.val = (N); _l.s.type = Lisp_Int; _l; }))
494 #else
495 extern Lisp_Object make_number (EMACS_INT);
496 #endif
497
498 #endif /* USE_LISP_UNION_TYPE */
499
500 /* For integers known to be positive, XFASTINT sometimes provides
501 faster retrieval and XSETFASTINT provides faster storage.
502 If not, fallback on the non-accelerated path. */
503 #ifndef XFASTINT
504 # define XFASTINT(a) (XINT (a))
505 # define XSETFASTINT(a, b) (XSETINT (a, b))
506 #endif
507
508 #define EQ(x, y) (XHASH (x) == XHASH (y))
509
510 #ifndef XPNTR
511 #ifdef HAVE_SHM
512 /* In this representation, data is found in two widely separated segments. */
513 extern size_t pure_size;
514 #define XPNTR(a) \
515 (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
516 #else /* not HAVE_SHM */
517 #ifdef DATA_SEG_BITS
518 /* This case is used for the rt-pc.
519 In the diffs I was given, it checked for ptr = 0
520 and did not adjust it in that case.
521 But I don't think that zero should ever be found
522 in a Lisp object whose data type says it points to something. */
523 #define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
524 #else
525 /* Some versions of gcc seem to consider the bitfield width when
526 issuing the "cast to pointer from integer of different size"
527 warning, so the cast is here to widen the value back to its natural
528 size. */
529 #define XPNTR(a) ((EMACS_INT) XUINT (a))
530 #endif
531 #endif /* not HAVE_SHM */
532 #endif /* no XPNTR */
533
534 /* Largest and smallest representable fixnum values. These are the C
535 values. */
536
537 #ifdef USE_2_TAGS_FOR_INTS
538 # define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << VALBITS)
539 # define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << VALBITS) - 1)
540 /* Mask indicating the significant bits of a Lisp_Int.
541 I.e. (x & INTMASK) == XUINT (make_number (x)). */
542 # define INTMASK ((((EMACS_INT) 1) << (VALBITS + 1)) - 1)
543 #else
544 # define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << (VALBITS - 1))
545 # define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << (VALBITS - 1)) - 1)
546 /* Mask indicating the significant bits of a Lisp_Int.
547 I.e. (x & INTMASK) == XUINT (make_number (x)). */
548 # define INTMASK ((((EMACS_INT) 1) << VALBITS) - 1)
549 #endif
550
551 /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
552 written this way so that it also works if I is of unsigned
553 type. */
554
555 #define FIXNUM_OVERFLOW_P(i) \
556 ((i) > MOST_POSITIVE_FIXNUM \
557 || ((i) < 0 && (i) < MOST_NEGATIVE_FIXNUM))
558
559 /* Extract a value or address from a Lisp_Object. */
560
561 #define XCONS(a) (eassert (CONSP(a)),(struct Lisp_Cons *) XPNTR(a))
562 #define XVECTOR(a) (eassert (VECTORLIKEP(a)),(struct Lisp_Vector *) XPNTR(a))
563 #define XSTRING(a) (eassert (STRINGP(a)),(struct Lisp_String *) XPNTR(a))
564 #define XSYMBOL(a) (eassert (SYMBOLP(a)),(struct Lisp_Symbol *) XPNTR(a))
565 #define XFLOAT(a) (eassert (FLOATP(a)),(struct Lisp_Float *) XPNTR(a))
566
567 /* Misc types. */
568
569 #define XMISC(a) ((union Lisp_Misc *) XPNTR(a))
570 #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC(a)->u_any))
571 #define XMISCTYPE(a) (XMISCANY (a)->type)
572 #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC(a)->u_marker))
573 #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC(a)->u_overlay))
574 #define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC(a)->u_save_value))
575
576 /* Forwarding object types. */
577
578 #define XFWDTYPE(a) (a->u_intfwd.type)
579 #define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd))
580 #define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd))
581 #define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd))
582 #define XBUFFER_OBJFWD(a) \
583 (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
584 #define XKBOARD_OBJFWD(a) \
585 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
586
587 /* Pseudovector types. */
588
589 #define XPROCESS(a) (eassert (PROCESSP(a)),(struct Lisp_Process *) XPNTR(a))
590 #define XWINDOW(a) (eassert (WINDOWP(a)),(struct window *) XPNTR(a))
591 #define XTERMINAL(a) (eassert (TERMINALP(a)),(struct terminal *) XPNTR(a))
592 #define XSUBR(a) (eassert (SUBRP(a)),(struct Lisp_Subr *) XPNTR(a))
593 #define XBUFFER(a) (eassert (BUFFERP(a)),(struct buffer *) XPNTR(a))
594 #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a))
595 #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR(a))
596 #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a))
597
598 /* Construct a Lisp_Object from a value or address. */
599
600 #define XSETINT(a, b) (a) = make_number (b)
601 #define XSETCONS(a, b) XSET (a, Lisp_Cons, b)
602 #define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b)
603 #define XSETSTRING(a, b) XSET (a, Lisp_String, b)
604 #define XSETSYMBOL(a, b) XSET (a, Lisp_Symbol, b)
605 #define XSETFLOAT(a, b) XSET (a, Lisp_Float, b)
606
607 /* Misc types. */
608
609 #define XSETMISC(a, b) XSET (a, Lisp_Misc, b)
610 #define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
611
612 /* Pseudovector types. */
613
614 #define XSETPVECTYPE(v,code) ((v)->size |= PSEUDOVECTOR_FLAG | (code))
615 #define XSETPSEUDOVECTOR(a, b, code) \
616 (XSETVECTOR (a, b), \
617 eassert ((XVECTOR (a)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
618 == (PSEUDOVECTOR_FLAG | (code))))
619 #define XSETWINDOW_CONFIGURATION(a, b) \
620 (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
621 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
622 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
623 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
624 #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
625 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
626 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
627 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
628 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
629 #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
630
631 /* Convenience macros for dealing with Lisp arrays. */
632
633 #define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
634 #define ASIZE(ARRAY) XVECTOR ((ARRAY))->size
635 /* The IDX==IDX tries to detect when the macro argument is side-effecting. */
636 #define ASET(ARRAY, IDX, VAL) \
637 (eassert ((IDX) == (IDX)), \
638 eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
639 AREF ((ARRAY), (IDX)) = (VAL))
640
641 /* Convenience macros for dealing with Lisp strings. */
642
643 #define SDATA(string) (XSTRING (string)->data + 0)
644 #define SREF(string, index) (SDATA (string)[index] + 0)
645 #define SSET(string, index, new) (SDATA (string)[index] = (new))
646 #define SCHARS(string) (XSTRING (string)->size + 0)
647 #define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0)
648
649 #define STRING_SET_CHARS(string, newsize) \
650 (XSTRING (string)->size = (newsize))
651
652 #define STRING_COPYIN(string, index, new, count) \
653 bcopy (new, SDATA (string) + index, count)
654
655 /* Type checking. */
656
657 #define CHECK_TYPE(ok, Qxxxp, x) \
658 do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
659
660
661 \f
662 /* See the macros in intervals.h. */
663
664 typedef struct interval *INTERVAL;
665
666 /* Complain if object is not string or buffer type */
667 #define CHECK_STRING_OR_BUFFER(x) \
668 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
669
670 \f
671 /* In a cons, the markbit of the car is the gc mark bit */
672
673 struct Lisp_Cons
674 {
675 /* Please do not use the names of these elements in code other
676 than the core lisp implementation. Use XCAR and XCDR below. */
677 #ifdef HIDE_LISP_IMPLEMENTATION
678 Lisp_Object car_;
679 union
680 {
681 Lisp_Object cdr_;
682 struct Lisp_Cons *chain;
683 } u;
684 #else
685 Lisp_Object car;
686 union
687 {
688 Lisp_Object cdr;
689 struct Lisp_Cons *chain;
690 } u;
691 #endif
692 };
693
694 /* Take the car or cdr of something known to be a cons cell. */
695 /* The _AS_LVALUE macros shouldn't be used outside of the minimal set
696 of code that has to know what a cons cell looks like. Other code not
697 part of the basic lisp implementation should assume that the car and cdr
698 fields are not accessible as lvalues. (What if we want to switch to
699 a copying collector someday? Cached cons cell field addresses may be
700 invalidated at arbitrary points.) */
701 #ifdef HIDE_LISP_IMPLEMENTATION
702 #define XCAR_AS_LVALUE(c) (XCONS ((c))->car_)
703 #define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr_)
704 #else
705 #define XCAR_AS_LVALUE(c) (XCONS ((c))->car)
706 #define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr)
707 #endif
708
709 /* Use these from normal code. */
710 #define XCAR(c) LISP_MAKE_RVALUE(XCAR_AS_LVALUE(c))
711 #define XCDR(c) LISP_MAKE_RVALUE(XCDR_AS_LVALUE(c))
712
713 /* Use these to set the fields of a cons cell.
714
715 Note that both arguments may refer to the same object, so 'n'
716 should not be read after 'c' is first modified. Also, neither
717 argument should be evaluated more than once; side effects are
718 especially common in the second argument. */
719 #define XSETCAR(c,n) (XCAR_AS_LVALUE(c) = (n))
720 #define XSETCDR(c,n) (XCDR_AS_LVALUE(c) = (n))
721
722 /* Take the car or cdr of something whose type is not known. */
723 #define CAR(c) \
724 (CONSP ((c)) ? XCAR ((c)) \
725 : NILP ((c)) ? Qnil \
726 : wrong_type_argument (Qlistp, (c)))
727
728 #define CDR(c) \
729 (CONSP ((c)) ? XCDR ((c)) \
730 : NILP ((c)) ? Qnil \
731 : wrong_type_argument (Qlistp, (c)))
732
733 /* Take the car or cdr of something whose type is not known. */
734 #define CAR_SAFE(c) \
735 (CONSP ((c)) ? XCAR ((c)) : Qnil)
736
737 #define CDR_SAFE(c) \
738 (CONSP ((c)) ? XCDR ((c)) : Qnil)
739
740 /* Nonzero if STR is a multibyte string. */
741 #define STRING_MULTIBYTE(STR) \
742 (XSTRING (STR)->size_byte >= 0)
743
744 /* Return the length in bytes of STR. */
745
746 #ifdef GC_CHECK_STRING_BYTES
747
748 struct Lisp_String;
749 extern int string_bytes (struct Lisp_String *);
750 #define STRING_BYTES(S) string_bytes ((S))
751
752 #else /* not GC_CHECK_STRING_BYTES */
753
754 #define STRING_BYTES(STR) \
755 ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte)
756
757 #endif /* not GC_CHECK_STRING_BYTES */
758
759 /* Mark STR as a unibyte string. */
760 #define STRING_SET_UNIBYTE(STR) \
761 do { if (EQ (STR, empty_multibyte_string)) \
762 (STR) = empty_unibyte_string; \
763 else XSTRING (STR)->size_byte = -1; } while (0)
764
765 /* Mark STR as a multibyte string. Assure that STR contains only
766 ASCII characters in advance. */
767 #define STRING_SET_MULTIBYTE(STR) \
768 do { if (EQ (STR, empty_unibyte_string)) \
769 (STR) = empty_multibyte_string; \
770 else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
771
772 /* Get text properties. */
773 #define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0)
774
775 /* Set text properties. */
776 #define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
777
778 /* In a string or vector, the sign bit of the `size' is the gc mark bit */
779
780 struct Lisp_String
781 {
782 EMACS_INT size;
783 EMACS_INT size_byte;
784 INTERVAL intervals; /* text properties in this string */
785 unsigned char *data;
786 };
787
788 #ifdef offsetof
789 #define OFFSETOF(type,field) offsetof(type,field)
790 #else
791 #define OFFSETOF(type,field) \
792 ((int)((char*)&((type*)0)->field - (char*)0))
793 #endif
794
795 struct Lisp_Vector
796 {
797 EMACS_UINT size;
798 struct Lisp_Vector *next;
799 Lisp_Object contents[1];
800 };
801
802 /* If a struct is made to look like a vector, this macro returns the length
803 of the shortest vector that would hold that struct. */
804 #define VECSIZE(type) ((sizeof (type) \
805 - OFFSETOF (struct Lisp_Vector, contents[0]) \
806 + sizeof(Lisp_Object) - 1) /* round up */ \
807 / sizeof (Lisp_Object))
808
809 /* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
810 at the end and we need to compute the number of Lisp_Object fields (the
811 ones that the GC needs to trace). */
812 #define PSEUDOVECSIZE(type, nonlispfield) \
813 ((OFFSETOF(type, nonlispfield) - OFFSETOF(struct Lisp_Vector, contents[0])) \
814 / sizeof (Lisp_Object))
815
816 /* A char-table is a kind of vectorlike, with contents are like a
817 vector but with a few other slots. For some purposes, it makes
818 sense to handle a char-table with type struct Lisp_Vector. An
819 element of a char table can be any Lisp objects, but if it is a sub
820 char-table, we treat it a table that contains information of a
821 specific range of characters. A sub char-table has the same
822 structure as a vector. A sub char table appears only in an element
823 of a char-table, and there's no way to access it directly from
824 Emacs Lisp program. */
825
826 /* This is the number of slots that every char table must have. This
827 counts the ordinary slots and the top, defalt, parent, and purpose
828 slots. */
829 #define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1)
830
831 /* Return the number of "extra" slots in the char table CT. */
832
833 #define CHAR_TABLE_EXTRA_SLOTS(CT) \
834 (((CT)->size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
835
836 #ifdef __GNUC__
837
838 #define CHAR_TABLE_REF_ASCII(CT, IDX) \
839 ({struct Lisp_Char_Table *_tbl = NULL; \
840 Lisp_Object _val; \
841 do { \
842 _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \
843 _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \
844 : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \
845 if (NILP (_val)) \
846 _val = _tbl->defalt; \
847 } while (NILP (_val) && ! NILP (_tbl->parent)); \
848 _val; })
849
850 #else /* not __GNUC__ */
851
852 #define CHAR_TABLE_REF_ASCII(CT, IDX) \
853 (! NILP (XCHAR_TABLE (CT)->ascii) \
854 ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
855 ? XCHAR_TABLE (CT)->ascii \
856 : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \
857 ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \
858 : char_table_ref ((CT), (IDX))) \
859 : char_table_ref ((CT), (IDX)))
860
861 #endif /* not __GNUC__ */
862
863 /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
864 characters. Do not check validity of CT. */
865 #define CHAR_TABLE_REF(CT, IDX) \
866 (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \
867 : char_table_ref ((CT), (IDX)))
868
869 /* Almost equivalent to Faref (CT, IDX). However, if the result is
870 not a character, return IDX.
871
872 For these characters, do not check validity of CT
873 and do not follow parent. */
874 #define CHAR_TABLE_TRANSLATE(CT, IDX) \
875 char_table_translate (CT, IDX)
876
877 /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
878 8-bit European characters. Do not check validity of CT. */
879 #define CHAR_TABLE_SET(CT, IDX, VAL) \
880 (((IDX) >= 0 && ASCII_CHAR_P (IDX) \
881 && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii)) \
882 ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
883 : char_table_set (CT, IDX, VAL))
884
885 #define CHARTAB_SIZE_BITS_0 6
886 #define CHARTAB_SIZE_BITS_1 4
887 #define CHARTAB_SIZE_BITS_2 5
888 #define CHARTAB_SIZE_BITS_3 7
889
890 extern const int chartab_size[4];
891
892 struct Lisp_Sub_Char_Table;
893
894 struct Lisp_Char_Table
895 {
896 /* This is the vector's size field, which also holds the
897 pseudovector type information. It holds the size, too.
898 The size counts the defalt, parent, purpose, ascii,
899 contents, and extras slots. */
900 EMACS_UINT size;
901 struct Lisp_Vector *next;
902
903 /* This holds a default value,
904 which is used whenever the value for a specific character is nil. */
905 Lisp_Object defalt;
906
907 /* This points to another char table, which we inherit from when the
908 value for a specific character is nil. The `defalt' slot takes
909 precedence over this. */
910 Lisp_Object parent;
911
912 /* This is a symbol which says what kind of use this char-table is
913 meant for. */
914 Lisp_Object purpose;
915
916 /* The bottom sub char-table for characters of the range 0..127. It
917 is nil if none of ASCII character has a specific value. */
918 Lisp_Object ascii;
919
920 Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
921
922 /* These hold additional data. It is a vector. */
923 Lisp_Object extras[1];
924 };
925
926 struct Lisp_Sub_Char_Table
927 {
928 /* This is the vector's size field, which also holds the
929 pseudovector type information. It holds the size, too. */
930 EMACS_INT size;
931 struct Lisp_Vector *next;
932
933 /* Depth of this sub char-table. It should be 1, 2, or 3. A sub
934 char-table of depth 1 contains 16 elements, and each element
935 covers 4096 (128*32) characters. A sub char-table of depth 2
936 contains 32 elements, and each element covers 128 characters. A
937 sub char-table of depth 3 contains 128 elements, and each element
938 is for one character. */
939 Lisp_Object depth;
940
941 /* Minimum character covered by the sub char-table. */
942 Lisp_Object min_char;
943
944 Lisp_Object contents[1];
945 };
946
947 /* A boolvector is a kind of vectorlike, with contents are like a string. */
948 struct Lisp_Bool_Vector
949 {
950 /* This is the vector's size field. It doesn't have the real size,
951 just the subtype information. */
952 EMACS_UINT vector_size;
953 struct Lisp_Vector *next;
954 /* This is the size in bits. */
955 EMACS_UINT size;
956 /* This contains the actual bits, packed into bytes. */
957 unsigned char data[1];
958 };
959
960 /* This structure describes a built-in function.
961 It is generated by the DEFUN macro only.
962 defsubr makes it into a Lisp object.
963
964 This type is treated in most respects as a pseudovector,
965 but since we never dynamically allocate or free them,
966 we don't need a next-vector field. */
967
968 struct Lisp_Subr
969 {
970 EMACS_UINT size;
971 Lisp_Object (*function) ();
972 short min_args, max_args;
973 const char *symbol_name;
974 char *intspec;
975 char *doc;
976 };
977
978 \f
979 /***********************************************************************
980 Symbols
981 ***********************************************************************/
982
983 /* Interned state of a symbol. */
984
985 enum symbol_interned
986 {
987 SYMBOL_UNINTERNED = 0,
988 SYMBOL_INTERNED = 1,
989 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
990 };
991
992 enum symbol_redirect
993 {
994 SYMBOL_PLAINVAL = 4,
995 SYMBOL_VARALIAS = 1,
996 SYMBOL_LOCALIZED = 2,
997 SYMBOL_FORWARDED = 3
998 };
999
1000 /* In a symbol, the markbit of the plist is used as the gc mark bit */
1001
1002 struct Lisp_Symbol
1003 {
1004 unsigned gcmarkbit : 1;
1005
1006 /* Indicates where the value can be found:
1007 0 : it's a plain var, the value is in the `value' field.
1008 1 : it's a varalias, the value is really in the `alias' symbol.
1009 2 : it's a localized var, the value is in the `blv' object.
1010 3 : it's a forwarding variable, the value is in `forward'.
1011 */
1012 enum symbol_redirect redirect : 3;
1013
1014 /* Non-zero means symbol is constant, i.e. changing its value
1015 should signal an error. If the value is 3, then the var
1016 can be changed, but only by `defconst'. */
1017 unsigned constant : 2;
1018
1019 /* Interned state of the symbol. This is an enumerator from
1020 enum symbol_interned. */
1021 unsigned interned : 2;
1022
1023 /* The symbol's name, as a Lisp string.
1024
1025 The name "xname" is used to intentionally break code referring to
1026 the old field "name" of type pointer to struct Lisp_String. */
1027 Lisp_Object xname;
1028
1029 /* Value of the symbol or Qunbound if unbound. If this symbol is a
1030 defvaralias, `alias' contains the symbol for which it is an
1031 alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get
1032 and set a symbol's value, to take defvaralias into account. */
1033 union {
1034 Lisp_Object value;
1035 struct Lisp_Symbol *alias;
1036 struct Lisp_Buffer_Local_Value *blv;
1037 union Lisp_Fwd *fwd;
1038 } val;
1039
1040 /* Function value of the symbol or Qunbound if not fboundp. */
1041 Lisp_Object function;
1042
1043 /* The symbol's property list. */
1044 Lisp_Object plist;
1045
1046 /* Next symbol in obarray bucket, if the symbol is interned. */
1047 struct Lisp_Symbol *next;
1048 };
1049
1050 /* Value is name of symbol. */
1051
1052 #define SYMBOL_VAL(sym) \
1053 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
1054 #define SYMBOL_ALIAS(sym) \
1055 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
1056 #define SYMBOL_BLV(sym) \
1057 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
1058 #define SYMBOL_FWD(sym) \
1059 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
1060 #define SET_SYMBOL_VAL(sym, v) \
1061 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
1062 #define SET_SYMBOL_ALIAS(sym, v) \
1063 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
1064 #define SET_SYMBOL_BLV(sym, v) \
1065 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
1066 #define SET_SYMBOL_FWD(sym, v) \
1067 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
1068
1069 #define SYMBOL_NAME(sym) \
1070 LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
1071
1072 /* Value is non-zero if SYM is an interned symbol. */
1073
1074 #define SYMBOL_INTERNED_P(sym) \
1075 (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
1076
1077 /* Value is non-zero if SYM is interned in initial_obarray. */
1078
1079 #define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
1080 (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
1081
1082 /* Value is non-zero if symbol is considered a constant, i.e. its
1083 value cannot be changed (there is an exception for keyword symbols,
1084 whose value can be set to the keyword symbol itself). */
1085
1086 #define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
1087
1088 \f
1089 /***********************************************************************
1090 Hash Tables
1091 ***********************************************************************/
1092
1093 /* The structure of a Lisp hash table. */
1094
1095 struct Lisp_Hash_Table
1096 {
1097 /* Vector fields. The hash table code doesn't refer to these. */
1098 EMACS_UINT size;
1099 struct Lisp_Vector *vec_next;
1100
1101 /* Function used to compare keys. */
1102 Lisp_Object test;
1103
1104 /* Nil if table is non-weak. Otherwise a symbol describing the
1105 weakness of the table. */
1106 Lisp_Object weak;
1107
1108 /* When the table is resized, and this is an integer, compute the
1109 new size by adding this to the old size. If a float, compute the
1110 new size by multiplying the old size with this factor. */
1111 Lisp_Object rehash_size;
1112
1113 /* Resize hash table when number of entries/ table size is >= this
1114 ratio, a float. */
1115 Lisp_Object rehash_threshold;
1116
1117 /* Vector of hash codes.. If hash[I] is nil, this means that that
1118 entry I is unused. */
1119 Lisp_Object hash;
1120
1121 /* Vector used to chain entries. If entry I is free, next[I] is the
1122 entry number of the next free item. If entry I is non-free,
1123 next[I] is the index of the next entry in the collision chain. */
1124 Lisp_Object next;
1125
1126 /* Index of first free entry in free list. */
1127 Lisp_Object next_free;
1128
1129 /* Bucket vector. A non-nil entry is the index of the first item in
1130 a collision chain. This vector's size can be larger than the
1131 hash table size to reduce collisions. */
1132 Lisp_Object index;
1133
1134 /* User-supplied hash function, or nil. */
1135 Lisp_Object user_hash_function;
1136
1137 /* User-supplied key comparison function, or nil. */
1138 Lisp_Object user_cmp_function;
1139
1140 /* Only the fields above are traced normally by the GC. The ones below
1141 `count' are special and are either ignored by the GC or traced in
1142 a special way (e.g. because of weakness). */
1143
1144 /* Number of key/value entries in the table. */
1145 unsigned int count;
1146
1147 /* Vector of keys and values. The key of item I is found at index
1148 2 * I, the value is found at index 2 * I + 1.
1149 This is gc_marked specially if the table is weak. */
1150 Lisp_Object key_and_value;
1151
1152 /* Next weak hash table if this is a weak hash table. The head
1153 of the list is in weak_hash_tables. */
1154 struct Lisp_Hash_Table *next_weak;
1155
1156 /* C function to compare two keys. */
1157 int (* cmpfn) (struct Lisp_Hash_Table *, Lisp_Object,
1158 unsigned, Lisp_Object, unsigned);
1159
1160 /* C function to compute hash code. */
1161 unsigned (* hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
1162 };
1163
1164
1165 #define XHASH_TABLE(OBJ) \
1166 ((struct Lisp_Hash_Table *) XPNTR (OBJ))
1167
1168 #define XSET_HASH_TABLE(VAR, PTR) \
1169 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
1170
1171 #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE)
1172
1173 #define CHECK_HASH_TABLE(x) \
1174 CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x)
1175
1176 /* Value is the key part of entry IDX in hash table H. */
1177
1178 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
1179
1180 /* Value is the value part of entry IDX in hash table H. */
1181
1182 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
1183
1184 /* Value is the index of the next entry following the one at IDX
1185 in hash table H. */
1186
1187 #define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX))
1188
1189 /* Value is the hash code computed for entry IDX in hash table H. */
1190
1191 #define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX))
1192
1193 /* Value is the index of the element in hash table H that is the
1194 start of the collision list at index IDX in the index vector of H. */
1195
1196 #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
1197
1198 /* Value is the size of hash table H. */
1199
1200 #define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size
1201
1202 /* Default size for hash tables if not specified. */
1203
1204 #define DEFAULT_HASH_SIZE 65
1205
1206 /* Default threshold specifying when to resize a hash table. The
1207 value gives the ratio of current entries in the hash table and the
1208 size of the hash table. */
1209
1210 #define DEFAULT_REHASH_THRESHOLD 0.8
1211
1212 /* Default factor by which to increase the size of a hash table. */
1213
1214 #define DEFAULT_REHASH_SIZE 1.5
1215
1216 \f
1217 /* These structures are used for various misc types. */
1218
1219 struct Lisp_Misc_Any /* Supertype of all Misc types. */
1220 {
1221 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_??? */
1222 unsigned gcmarkbit : 1;
1223 int spacer : 15;
1224 /* Make it as long as "Lisp_Free without padding". */
1225 void *fill;
1226 };
1227
1228 struct Lisp_Marker
1229 {
1230 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Marker */
1231 unsigned gcmarkbit : 1;
1232 int spacer : 13;
1233 /* This flag is temporarily used in the functions
1234 decode/encode_coding_object to record that the marker position
1235 must be adjusted after the conversion. */
1236 unsigned int need_adjustment : 1;
1237 /* 1 means normal insertion at the marker's position
1238 leaves the marker after the inserted text. */
1239 unsigned int insertion_type : 1;
1240 /* This is the buffer that the marker points into, or 0 if it points nowhere.
1241 Note: a chain of markers can contain markers pointing into different
1242 buffers (the chain is per buffer_text rather than per buffer, so it's
1243 shared between indirect buffers). */
1244 /* This is used for (other than NULL-checking):
1245 - Fmarker_buffer
1246 - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
1247 - unchain_marker: to find the list from which to unchain.
1248 - Fkill_buffer: to only unchain the markers of current indirect buffer.
1249 */
1250 struct buffer *buffer;
1251
1252 /* The remaining fields are meaningless in a marker that
1253 does not point anywhere. */
1254
1255 /* For markers that point somewhere,
1256 this is used to chain of all the markers in a given buffer. */
1257 /* We could remove it and use an array in buffer_text instead.
1258 That would also allow to preserve it ordered. */
1259 struct Lisp_Marker *next;
1260 /* This is the char position where the marker points. */
1261 EMACS_INT charpos;
1262 /* This is the byte position.
1263 It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
1264 used to implement the functionality of markers, but rather to (ab)use
1265 markers as a cache for char<->byte mappings). */
1266 EMACS_INT bytepos;
1267 };
1268
1269 /* Forwarding pointer to an int variable.
1270 This is allowed only in the value cell of a symbol,
1271 and it means that the symbol's value really lives in the
1272 specified int variable. */
1273 struct Lisp_Intfwd
1274 {
1275 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
1276 EMACS_INT *intvar;
1277 };
1278
1279 /* Boolean forwarding pointer to an int variable.
1280 This is like Lisp_Intfwd except that the ostensible
1281 "value" of the symbol is t if the int variable is nonzero,
1282 nil if it is zero. */
1283 struct Lisp_Boolfwd
1284 {
1285 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
1286 int *boolvar;
1287 };
1288
1289 /* Forwarding pointer to a Lisp_Object variable.
1290 This is allowed only in the value cell of a symbol,
1291 and it means that the symbol's value really lives in the
1292 specified variable. */
1293 struct Lisp_Objfwd
1294 {
1295 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
1296 Lisp_Object *objvar;
1297 };
1298
1299 /* Like Lisp_Objfwd except that value lives in a slot in the
1300 current buffer. Value is byte index of slot within buffer. */
1301 struct Lisp_Buffer_Objfwd
1302 {
1303 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
1304 int offset;
1305 Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
1306 };
1307
1308 /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
1309 the symbol has buffer-local or frame-local bindings. (Exception:
1310 some buffer-local variables are built-in, with their values stored
1311 in the buffer structure itself. They are handled differently,
1312 using struct Lisp_Buffer_Objfwd.)
1313
1314 The `realvalue' slot holds the variable's current value, or a
1315 forwarding pointer to where that value is kept. This value is the
1316 one that corresponds to the loaded binding. To read or set the
1317 variable, you must first make sure the right binding is loaded;
1318 then you can access the value in (or through) `realvalue'.
1319
1320 `buffer' and `frame' are the buffer and frame for which the loaded
1321 binding was found. If those have changed, to make sure the right
1322 binding is loaded it is necessary to find which binding goes with
1323 the current buffer and selected frame, then load it. To load it,
1324 first unload the previous binding, then copy the value of the new
1325 binding into `realvalue' (or through it). Also update
1326 LOADED-BINDING to point to the newly loaded binding.
1327
1328 `local_if_set' indicates that merely setting the variable creates a
1329 local binding for the current buffer. Otherwise the latter, setting
1330 the variable does not do that; only make-local-variable does that. */
1331
1332 struct Lisp_Buffer_Local_Value
1333 {
1334 /* 1 means that merely setting the variable creates a local
1335 binding for the current buffer */
1336 unsigned int local_if_set : 1;
1337 /* 1 means this variable can have frame-local bindings, otherwise, it is
1338 can have buffer-local bindings. The two cannot be combined. */
1339 unsigned int frame_local : 1;
1340 /* 1 means that the binding now loaded was found.
1341 Presumably equivalent to (defcell!=valcell) */
1342 unsigned int found : 1;
1343 /* If non-NULL, a forwarding to the C var where it should also be set. */
1344 union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
1345 /* The buffer or frame for which the loaded binding was found. */
1346 Lisp_Object where;
1347 /* A cons cell that holds the default value. It has the form
1348 (SYMBOL . DEFAULT-VALUE). */
1349 Lisp_Object defcell;
1350 /* The cons cell from `where's parameter alist.
1351 It always has the form (SYMBOL . VALUE)
1352 Note that if `forward' is non-nil, VALUE may be out of date.
1353 Also if the currently loaded binding is the default binding, then
1354 this is `eq'ual to defcell. */
1355 Lisp_Object valcell;
1356 };
1357
1358 #define BLV_FOUND(blv) \
1359 (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
1360 #define SET_BLV_FOUND(blv, v) \
1361 (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
1362
1363 #define BLV_VALUE(blv) (XCDR ((blv)->valcell))
1364 #define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
1365
1366 /* START and END are markers in the overlay's buffer, and
1367 PLIST is the overlay's property list. */
1368 struct Lisp_Overlay
1369 /* An overlay's real data content is:
1370 - plist
1371 - buffer
1372 - insertion type of both ends
1373 - start & start_byte
1374 - end & end_byte
1375 - next (singly linked list of overlays).
1376 - start_next and end_next (singly linked list of markers).
1377 I.e. 9words plus 2 bits, 3words of which are for external linked lists.
1378 */
1379 {
1380 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */
1381 unsigned gcmarkbit : 1;
1382 int spacer : 15;
1383 struct Lisp_Overlay *next;
1384 Lisp_Object start, end, plist;
1385 };
1386
1387 /* Like Lisp_Objfwd except that value lives in a slot in the
1388 current kboard. */
1389 struct Lisp_Kboard_Objfwd
1390 {
1391 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */
1392 int offset;
1393 };
1394
1395 /* Hold a C pointer for later use.
1396 This type of object is used in the arg to record_unwind_protect. */
1397 struct Lisp_Save_Value
1398 {
1399 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Save_Value */
1400 unsigned gcmarkbit : 1;
1401 int spacer : 14;
1402 /* If DOGC is set, POINTER is the address of a memory
1403 area containing INTEGER potential Lisp_Objects. */
1404 unsigned int dogc : 1;
1405 void *pointer;
1406 int integer;
1407 };
1408
1409
1410 /* A miscellaneous object, when it's on the free list. */
1411 struct Lisp_Free
1412 {
1413 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Free */
1414 unsigned gcmarkbit : 1;
1415 int spacer : 15;
1416 union Lisp_Misc *chain;
1417 #ifdef USE_LSB_TAG
1418 /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
1419 This assumes that Lisp_Marker is the largest of the alternatives and
1420 that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */
1421 char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
1422 << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)];
1423 #endif
1424 };
1425
1426 /* To get the type field of a union Lisp_Misc, use XMISCTYPE.
1427 It uses one of these struct subtypes to get the type field. */
1428
1429 union Lisp_Misc
1430 {
1431 struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
1432 struct Lisp_Free u_free; /* Includes padding to force alignment. */
1433 struct Lisp_Marker u_marker; /* 5 */
1434 struct Lisp_Overlay u_overlay; /* 5 */
1435 struct Lisp_Save_Value u_save_value; /* 3 */
1436 };
1437
1438 union Lisp_Fwd
1439 {
1440 struct Lisp_Intfwd u_intfwd; /* 2 */
1441 struct Lisp_Boolfwd u_boolfwd; /* 2 */
1442 struct Lisp_Objfwd u_objfwd; /* 2 */
1443 struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */
1444 struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */
1445 };
1446 \f
1447 /* Lisp floating point type */
1448 struct Lisp_Float
1449 {
1450 union
1451 {
1452 #ifdef HIDE_LISP_IMPLEMENTATION
1453 double data_;
1454 #else
1455 double data;
1456 #endif
1457 struct Lisp_Float *chain;
1458 } u;
1459 };
1460
1461 #ifdef HIDE_LISP_IMPLEMENTATION
1462 #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data_ : XFLOAT (f)->u.data_)
1463 #else
1464 #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
1465 /* This should be used only in alloc.c, which always disables
1466 HIDE_LISP_IMPLEMENTATION. */
1467 #define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
1468 #endif
1469
1470 /* A character, declared with the following typedef, is a member
1471 of some character set associated with the current buffer. */
1472 #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */
1473 #define _UCHAR_T
1474 typedef unsigned char UCHAR;
1475 #endif
1476
1477 /* Meanings of slots in a Lisp_Compiled: */
1478
1479 #define COMPILED_ARGLIST 0
1480 #define COMPILED_BYTECODE 1
1481 #define COMPILED_CONSTANTS 2
1482 #define COMPILED_STACK_DEPTH 3
1483 #define COMPILED_DOC_STRING 4
1484 #define COMPILED_INTERACTIVE 5
1485
1486 /* Flag bits in a character. These also get used in termhooks.h.
1487 Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
1488 (MUlti-Lingual Emacs) might need 22 bits for the character value
1489 itself, so we probably shouldn't use any bits lower than 0x0400000. */
1490 #define CHAR_ALT (0x0400000)
1491 #define CHAR_SUPER (0x0800000)
1492 #define CHAR_HYPER (0x1000000)
1493 #define CHAR_SHIFT (0x2000000)
1494 #define CHAR_CTL (0x4000000)
1495 #define CHAR_META (0x8000000)
1496
1497 #define CHAR_MODIFIER_MASK \
1498 (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META)
1499
1500
1501 /* Actually, the current Emacs uses 22 bits for the character value
1502 itself. */
1503 #define CHARACTERBITS 22
1504
1505 /* The maximum byte size consumed by push_key_description.
1506 All callers should assure that at least this size of memory is
1507 allocated at the place pointed by the second argument.
1508
1509 There are 6 modifiers, each consumes 2 chars.
1510 The octal form of a character code consumes
1511 (1 + CHARACTERBITS / 3 + 1) chars (including backslash at the head).
1512 We need one more byte for string terminator `\0'. */
1513 #define KEY_DESCRIPTION_SIZE ((2 * 6) + 1 + (CHARACTERBITS / 3) + 1 + 1)
1514
1515 \f
1516 /* The glyph datatype, used to represent characters on the display.
1517 It consists of a char code and a face id. */
1518
1519 typedef struct {
1520 int ch;
1521 int face_id;
1522 } GLYPH;
1523
1524 /* Return a glyph's character code. */
1525 #define GLYPH_CHAR(glyph) ((glyph).ch)
1526
1527 /* Return a glyph's face ID. */
1528 #define GLYPH_FACE(glyph) ((glyph).face_id)
1529
1530 #define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
1531 #define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
1532 #define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face))
1533
1534 /* Return 1 if GLYPH contains valid character code. */
1535 #define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph), 1)
1536
1537
1538 /* Glyph Code from a display vector may either be an integer which
1539 encodes a char code in the lower CHARACTERBITS bits and a (very small)
1540 face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
1541
1542 #define GLYPH_CODE_CHAR(gc) \
1543 (CONSP (gc) ? XINT (XCAR (gc)) : INTEGERP (gc) ? (XINT (gc) & ((1 << CHARACTERBITS)-1)) : 0)
1544
1545 #define GLYPH_CODE_FACE(gc) \
1546 (CONSP (gc) ? XINT (XCDR (gc)) : INTEGERP (gc) ? (XINT (gc) >> CHARACTERBITS) : DEFAULT_FACE_ID)
1547
1548 /* Return 1 if glyph code from display vector contains valid character code. */
1549 #define GLYPH_CODE_CHAR_VALID_P(gc) CHAR_VALID_P (GLYPH_CODE_CHAR (gc), 1)
1550
1551 #define GLYPH_CODE_P(gc) ((CONSP (gc) && INTEGERP (XCAR (gc)) && INTEGERP (XCDR (gc))) || INTEGERP (gc))
1552
1553 /* Only called when GLYPH_CODE_P (gc) is true. */
1554 #define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
1555 do \
1556 { \
1557 if (CONSP (gc)) \
1558 SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
1559 else \
1560 SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
1561 (XINT (gc) >> CHARACTERBITS)); \
1562 } \
1563 while (0)
1564
1565 /* The ID of the mode line highlighting face. */
1566 #define GLYPH_MODE_LINE_FACE 1
1567 \f
1568 /* Data type checking */
1569
1570 #define NILP(x) EQ (x, Qnil)
1571
1572 #define NUMBERP(x) (INTEGERP (x) || FLOATP (x))
1573 #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0)
1574
1575 #define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
1576 #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
1577 #define MISCP(x) (XTYPE ((x)) == Lisp_Misc)
1578 #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike)
1579 #define STRINGP(x) (XTYPE ((x)) == Lisp_String)
1580 #define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
1581
1582 #define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
1583 #define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
1584 #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
1585 #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
1586 #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
1587
1588 #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
1589 #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
1590 #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
1591 #define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
1592 #define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
1593
1594 /* True if object X is a pseudovector whose code is CODE. */
1595 #define PSEUDOVECTORP(x, code) \
1596 (VECTORLIKEP (x) \
1597 && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \
1598 == (PSEUDOVECTOR_FLAG | (code))))
1599
1600 /* Test for specific pseudovector types. */
1601 #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
1602 #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
1603 #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
1604 #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
1605 #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
1606 #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
1607 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
1608 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
1609 #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
1610 #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
1611 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
1612
1613 /* Test for image (image . spec) */
1614 #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
1615
1616 /* Array types. */
1617
1618 #define ARRAYP(x) \
1619 (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
1620 \f
1621 #define CHECK_LIST(x) \
1622 CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
1623
1624 #define CHECK_LIST_CONS(x, y) \
1625 CHECK_TYPE (CONSP (x), Qlistp, y)
1626
1627 #define CHECK_LIST_END(x, y) \
1628 CHECK_TYPE (NILP (x), Qlistp, y)
1629
1630 #define CHECK_STRING(x) \
1631 CHECK_TYPE (STRINGP (x), Qstringp, x)
1632
1633 #define CHECK_STRING_CAR(x) \
1634 CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x))
1635
1636 #define CHECK_CONS(x) \
1637 CHECK_TYPE (CONSP (x), Qconsp, x)
1638
1639 #define CHECK_SYMBOL(x) \
1640 CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
1641
1642 #define CHECK_CHAR_TABLE(x) \
1643 CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x)
1644
1645 #define CHECK_VECTOR(x) \
1646 CHECK_TYPE (VECTORP (x), Qvectorp, x)
1647
1648 #define CHECK_VECTOR_OR_STRING(x) \
1649 CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x)
1650
1651 #define CHECK_ARRAY(x, Qxxxp) \
1652 CHECK_TYPE (ARRAYP (x), Qxxxp, x)
1653
1654 #define CHECK_VECTOR_OR_CHAR_TABLE(x) \
1655 CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x)
1656
1657 #define CHECK_BUFFER(x) \
1658 CHECK_TYPE (BUFFERP (x), Qbufferp, x)
1659
1660 #define CHECK_WINDOW(x) \
1661 CHECK_TYPE (WINDOWP (x), Qwindowp, x)
1662
1663 #define CHECK_WINDOW_CONFIGURATION(x) \
1664 CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
1665
1666 /* This macro rejects windows on the interior of the window tree as
1667 "dead", which is what we want; this is an argument-checking macro, and
1668 the user should never get access to interior windows.
1669
1670 A window of any sort, leaf or interior, is dead if the buffer,
1671 vchild, and hchild members are all nil. */
1672
1673 #define CHECK_LIVE_WINDOW(x) \
1674 CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x)
1675
1676 #define CHECK_PROCESS(x) \
1677 CHECK_TYPE (PROCESSP (x), Qprocessp, x)
1678
1679 #define CHECK_SUBR(x) \
1680 CHECK_TYPE (SUBRP (x), Qsubrp, x)
1681
1682 #define CHECK_NUMBER(x) \
1683 CHECK_TYPE (INTEGERP (x), Qintegerp, x)
1684
1685 #define CHECK_NATNUM(x) \
1686 CHECK_TYPE (NATNUMP (x), Qwholenump, x)
1687
1688 #define CHECK_MARKER(x) \
1689 CHECK_TYPE (MARKERP (x), Qmarkerp, x)
1690
1691 #define CHECK_NUMBER_COERCE_MARKER(x) \
1692 do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
1693 else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
1694
1695 #define XFLOATINT(n) extract_float((n))
1696
1697 #define CHECK_FLOAT(x) \
1698 CHECK_TYPE (FLOATP (x), Qfloatp, x)
1699
1700 #define CHECK_NUMBER_OR_FLOAT(x) \
1701 CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x)
1702
1703 #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
1704 do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \
1705 else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
1706
1707 #define CHECK_OVERLAY(x) \
1708 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
1709
1710 /* Since we can't assign directly to the CAR or CDR fields of a cons
1711 cell, use these when checking that those fields contain numbers. */
1712 #define CHECK_NUMBER_CAR(x) \
1713 do { \
1714 Lisp_Object tmp = XCAR (x); \
1715 CHECK_NUMBER (tmp); \
1716 XSETCAR ((x), tmp); \
1717 } while (0)
1718
1719 #define CHECK_NUMBER_CDR(x) \
1720 do { \
1721 Lisp_Object tmp = XCDR (x); \
1722 CHECK_NUMBER (tmp); \
1723 XSETCDR ((x), tmp); \
1724 } while (0)
1725
1726 #define CHECK_NATNUM_CAR(x) \
1727 do { \
1728 Lisp_Object tmp = XCAR (x); \
1729 CHECK_NATNUM (tmp); \
1730 XSETCAR ((x), tmp); \
1731 } while (0)
1732
1733 #define CHECK_NATNUM_CDR(x) \
1734 do { \
1735 Lisp_Object tmp = XCDR (x); \
1736 CHECK_NATNUM (tmp); \
1737 XSETCDR ((x), tmp); \
1738 } while (0)
1739
1740 /* Cast pointers to this type to compare them. Some machines want int. */
1741 #define PNTR_COMPARISON_TYPE EMACS_UINT
1742 \f
1743 /* Define a built-in function for calling from Lisp.
1744 `lname' should be the name to give the function in Lisp,
1745 as a null-terminated C string.
1746 `fnname' should be the name of the function in C.
1747 By convention, it starts with F.
1748 `sname' should be the name for the C constant structure
1749 that records information on this function for internal use.
1750 By convention, it should be the same as `fnname' but with S instead of F.
1751 It's too bad that C macros can't compute this from `fnname'.
1752 `minargs' should be a number, the minimum number of arguments allowed.
1753 `maxargs' should be a number, the maximum number of arguments allowed,
1754 or else MANY or UNEVALLED.
1755 MANY means pass a vector of evaluated arguments,
1756 in the form of an integer number-of-arguments
1757 followed by the address of a vector of Lisp_Objects
1758 which contains the argument values.
1759 UNEVALLED means pass the list of unevaluated arguments
1760 `intspec' says how interactive arguments are to be fetched.
1761 If the string starts with a `(', `intspec' is evaluated and the resulting
1762 list is the list of arguments.
1763 If it's a string that doesn't start with `(', the value should follow
1764 the one of the doc string for `interactive'.
1765 A null string means call interactively with no arguments.
1766 `doc' is documentation for the user. */
1767
1768 /* This version of DEFUN declares a function prototype with the right
1769 arguments, so we can catch errors with maxargs at compile-time. */
1770 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
1771 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
1772 DECL_ALIGN (struct Lisp_Subr, sname) = \
1773 { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
1774 fnname, minargs, maxargs, lname, intspec, 0}; \
1775 Lisp_Object fnname
1776
1777 /* Note that the weird token-substitution semantics of ANSI C makes
1778 this work for MANY and UNEVALLED. */
1779 #define DEFUN_ARGS_MANY (int, Lisp_Object *)
1780 #define DEFUN_ARGS_UNEVALLED (Lisp_Object)
1781 #define DEFUN_ARGS_0 (void)
1782 #define DEFUN_ARGS_1 (Lisp_Object)
1783 #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
1784 #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
1785 #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1786 #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1787 Lisp_Object)
1788 #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1789 Lisp_Object, Lisp_Object)
1790 #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1791 Lisp_Object, Lisp_Object, Lisp_Object)
1792 #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1793 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1794
1795 /* Non-zero if OBJ is a Lisp function. */
1796 #define FUNCTIONP(OBJ) \
1797 ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
1798 || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
1799 || COMPILEDP (OBJ) \
1800 || SUBRP (OBJ))
1801
1802 /* defsubr (Sname);
1803 is how we define the symbol for function `name' at start-up time. */
1804 extern void defsubr (struct Lisp_Subr *);
1805
1806 #define MANY -2
1807 #define UNEVALLED -1
1808
1809 extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1810 extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1811 extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
1812 extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
1813 extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
1814
1815 /* Macros we use to define forwarded Lisp variables.
1816 These are used in the syms_of_FILENAME functions. */
1817
1818 #define DEFVAR_LISP(lname, vname, doc) \
1819 do { \
1820 static struct Lisp_Objfwd o_fwd; \
1821 defvar_lisp (&o_fwd, lname, vname); \
1822 } while (0)
1823 #define DEFVAR_LISP_NOPRO(lname, vname, doc) \
1824 do { \
1825 static struct Lisp_Objfwd o_fwd; \
1826 defvar_lisp_nopro (&o_fwd, lname, vname); \
1827 } while (0)
1828 #define DEFVAR_BOOL(lname, vname, doc) \
1829 do { \
1830 static struct Lisp_Boolfwd b_fwd; \
1831 defvar_bool (&b_fwd, lname, vname); \
1832 } while (0)
1833 #define DEFVAR_INT(lname, vname, doc) \
1834 do { \
1835 static struct Lisp_Intfwd i_fwd; \
1836 defvar_int (&i_fwd, lname, vname); \
1837 } while (0)
1838
1839 #define DEFVAR_KBOARD(lname, vname, doc) \
1840 do { \
1841 static struct Lisp_Kboard_Objfwd ko_fwd; \
1842 defvar_kboard (&ko_fwd, \
1843 lname, \
1844 (int)((char *)(&current_kboard->vname) \
1845 - (char *)current_kboard)); \
1846 } while (0)
1847
1848
1849 \f
1850 /* Structure for recording Lisp call stack for backtrace purposes. */
1851
1852 /* The special binding stack holds the outer values of variables while
1853 they are bound by a function application or a let form, stores the
1854 code to be executed for Lisp unwind-protect forms, and stores the C
1855 functions to be called for record_unwind_protect.
1856
1857 If func is non-zero, undoing this binding applies func to old_value;
1858 This implements record_unwind_protect.
1859
1860 Otherwise, the element is a variable binding.
1861
1862 If the symbol field is a symbol, it is an ordinary variable binding.
1863
1864 Otherwise, it should be a structure (SYMBOL WHERE . CURRENT-BUFFER),
1865 which means having bound a local value while CURRENT-BUFFER was active.
1866 If WHERE is nil this means we saw the default value when binding SYMBOL.
1867 WHERE being a buffer or frame means we saw a buffer-local or frame-local
1868 value. Other values of WHERE mean an internal error. */
1869
1870 typedef Lisp_Object (*specbinding_func) (Lisp_Object);
1871
1872 struct specbinding
1873 {
1874 Lisp_Object symbol, old_value;
1875 specbinding_func func;
1876 Lisp_Object unused; /* Dividing by 16 is faster than by 12 */
1877 };
1878
1879 extern struct specbinding *specpdl;
1880 extern struct specbinding *specpdl_ptr;
1881 extern int specpdl_size;
1882
1883 extern EMACS_INT max_specpdl_size;
1884
1885 #define SPECPDL_INDEX() (specpdl_ptr - specpdl)
1886
1887 /* Everything needed to describe an active condition case. */
1888 struct handler
1889 {
1890 /* The handler clauses and variable from the condition-case form. */
1891 /* For a handler set up in Lisp code, this is always a list.
1892 For an internal handler set up by internal_condition_case*,
1893 this can instead be the symbol t or `error'.
1894 t: handle all conditions.
1895 error: handle all conditions, and errors can run the debugger
1896 or display a backtrace. */
1897 Lisp_Object handler;
1898 Lisp_Object var;
1899 /* Fsignal stores here the condition-case clause that applies,
1900 and Fcondition_case thus knows which clause to run. */
1901 Lisp_Object chosen_clause;
1902
1903 /* Used to effect the longjump out to the handler. */
1904 struct catchtag *tag;
1905
1906 /* The next enclosing handler. */
1907 struct handler *next;
1908 };
1909
1910 extern struct handler *handlerlist;
1911
1912 /* This structure helps implement the `catch' and `throw' control
1913 structure. A struct catchtag contains all the information needed
1914 to restore the state of the interpreter after a non-local jump.
1915
1916 Handlers for error conditions (represented by `struct handler'
1917 structures) just point to a catch tag to do the cleanup required
1918 for their jumps.
1919
1920 catchtag structures are chained together in the C calling stack;
1921 the `next' member points to the next outer catchtag.
1922
1923 A call like (throw TAG VAL) searches for a catchtag whose `tag'
1924 member is TAG, and then unbinds to it. The `val' member is used to
1925 hold VAL while the stack is unwound; `val' is returned as the value
1926 of the catch form.
1927
1928 All the other members are concerned with restoring the interpreter
1929 state. */
1930
1931 struct catchtag
1932 {
1933 Lisp_Object tag;
1934 Lisp_Object val;
1935 struct catchtag *next;
1936 struct gcpro *gcpro;
1937 jmp_buf jmp;
1938 struct backtrace *backlist;
1939 struct handler *handlerlist;
1940 int lisp_eval_depth;
1941 int pdlcount;
1942 int poll_suppress_count;
1943 int interrupt_input_blocked;
1944 struct byte_stack *byte_stack;
1945 };
1946
1947 extern struct catchtag *catchlist;
1948 extern struct backtrace *backtrace_list;
1949
1950 extern Lisp_Object memory_signal_data;
1951
1952 /* An address near the bottom of the stack.
1953 Tells GC how to save a copy of the stack. */
1954 extern char *stack_bottom;
1955
1956 /* Check quit-flag and quit if it is non-nil.
1957 Typing C-g does not directly cause a quit; it only sets Vquit_flag.
1958 So the program needs to do QUIT at times when it is safe to quit.
1959 Every loop that might run for a long time or might not exit
1960 ought to do QUIT at least once, at a safe place.
1961 Unless that is impossible, of course.
1962 But it is very desirable to avoid creating loops where QUIT is impossible.
1963
1964 Exception: if you set immediate_quit to nonzero,
1965 then the handler that responds to the C-g does the quit itself.
1966 This is a good thing to do around a loop that has no side effects
1967 and (in particular) cannot call arbitrary Lisp code. */
1968
1969 #ifdef SYNC_INPUT
1970 extern void process_pending_signals (void);
1971 extern int pending_signals;
1972 #define ELSE_PENDING_SIGNALS \
1973 else if (pending_signals) \
1974 process_pending_signals ();
1975 #else /* not SYNC_INPUT */
1976 #define ELSE_PENDING_SIGNALS
1977 #endif /* not SYNC_INPUT */
1978
1979 #define QUIT \
1980 do { \
1981 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
1982 { \
1983 Lisp_Object flag = Vquit_flag; \
1984 Vquit_flag = Qnil; \
1985 if (EQ (Vthrow_on_input, flag)) \
1986 Fthrow (Vthrow_on_input, Qt); \
1987 Fsignal (Qquit, Qnil); \
1988 } \
1989 ELSE_PENDING_SIGNALS \
1990 } while (0)
1991
1992
1993 /* Nonzero if ought to quit now. */
1994
1995 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
1996 \f
1997 /* Variables used locally in the following case handling macros. */
1998 extern int case_temp1;
1999 extern Lisp_Object case_temp2;
2000
2001 /* Current buffer's map from characters to lower-case characters. */
2002
2003 #define DOWNCASE_TABLE current_buffer->downcase_table
2004
2005 /* Current buffer's map from characters to upper-case characters. */
2006
2007 #define UPCASE_TABLE current_buffer->upcase_table
2008
2009 /* Downcase a character, or make no change if that cannot be done. */
2010
2011 #define DOWNCASE(CH) \
2012 ((case_temp1 = (CH), \
2013 case_temp2 = CHAR_TABLE_REF (DOWNCASE_TABLE, case_temp1), \
2014 NATNUMP (case_temp2)) \
2015 ? XFASTINT (case_temp2) : case_temp1)
2016
2017 /* 1 if CH is upper case. */
2018
2019 #define UPPERCASEP(CH) (DOWNCASE (CH) != (CH))
2020
2021 /* 1 if CH is neither upper nor lower case. */
2022
2023 #define NOCASEP(CH) (UPCASE1 (CH) == (CH))
2024
2025 /* 1 if CH is lower case. */
2026
2027 #define LOWERCASEP(CH) (!UPPERCASEP (CH) && !NOCASEP(CH))
2028
2029 /* Upcase a character, or make no change if that cannot be done. */
2030
2031 #define UPCASE(CH) (!UPPERCASEP (CH) ? UPCASE1 (CH) : (CH))
2032
2033 /* Upcase a character known to be not upper case. */
2034
2035 #define UPCASE1(CH) \
2036 ((case_temp1 = (CH), \
2037 case_temp2 = CHAR_TABLE_REF (UPCASE_TABLE, case_temp1), \
2038 NATNUMP (case_temp2)) \
2039 ? XFASTINT (case_temp2) : case_temp1)
2040
2041 extern Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
2042 extern Lisp_Object Vascii_canon_table, Vascii_eqv_table;
2043 \f
2044 /* Number of bytes of structure consed since last GC. */
2045
2046 extern int consing_since_gc;
2047
2048 /* Thresholds for doing another gc. */
2049
2050 extern EMACS_INT gc_cons_threshold;
2051
2052 extern EMACS_INT gc_relative_threshold;
2053
2054 extern EMACS_INT memory_full_cons_threshold;
2055
2056 /* Structure for recording stack slots that need marking. */
2057
2058 /* This is a chain of structures, each of which points at a Lisp_Object
2059 variable whose value should be marked in garbage collection.
2060 Normally every link of the chain is an automatic variable of a function,
2061 and its `val' points to some argument or local variable of the function.
2062 On exit to the function, the chain is set back to the value it had on entry.
2063 This way, no link remains in the chain when the stack frame containing the
2064 link disappears.
2065
2066 Every function that can call Feval must protect in this fashion all
2067 Lisp_Object variables whose contents will be used again. */
2068
2069 extern struct gcpro *gcprolist;
2070
2071 struct gcpro
2072 {
2073 struct gcpro *next;
2074
2075 /* Address of first protected variable. */
2076 volatile Lisp_Object *var;
2077
2078 /* Number of consecutive protected variables. */
2079 int nvars;
2080
2081 #ifdef DEBUG_GCPRO
2082 int level;
2083 #endif
2084 };
2085
2086 /* Values of GC_MARK_STACK during compilation:
2087
2088 0 Use GCPRO as before
2089 1 Do the real thing, make GCPROs and UNGCPRO no-ops.
2090 2 Mark the stack, and check that everything GCPRO'd is
2091 marked.
2092 3 Mark using GCPRO's, mark stack last, and count how many
2093 dead objects are kept alive. */
2094
2095
2096 #define GC_USE_GCPROS_AS_BEFORE 0
2097 #define GC_MAKE_GCPROS_NOOPS 1
2098 #define GC_MARK_STACK_CHECK_GCPROS 2
2099 #define GC_USE_GCPROS_CHECK_ZOMBIES 3
2100
2101 #ifndef GC_MARK_STACK
2102 #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE
2103 #endif
2104
2105 #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
2106
2107 /* Do something silly with gcproN vars just so gcc shuts up. */
2108 /* You get warnings from MIPSPro... */
2109
2110 #define GCPRO1(varname) ((void) gcpro1)
2111 #define GCPRO2(varname1, varname2)(((void) gcpro2, (void) gcpro1))
2112 #define GCPRO3(varname1, varname2, varname3) \
2113 (((void) gcpro3, (void) gcpro2, (void) gcpro1))
2114 #define GCPRO4(varname1, varname2, varname3, varname4) \
2115 (((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
2116 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2117 (((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
2118 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2119 (((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
2120 #define UNGCPRO ((void) 0)
2121
2122 #else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
2123
2124 #ifndef DEBUG_GCPRO
2125
2126 #define GCPRO1(varname) \
2127 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
2128 gcprolist = &gcpro1; }
2129
2130 #define GCPRO2(varname1, varname2) \
2131 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2132 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2133 gcprolist = &gcpro2; }
2134
2135 #define GCPRO3(varname1, varname2, varname3) \
2136 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2137 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2138 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2139 gcprolist = &gcpro3; }
2140
2141 #define GCPRO4(varname1, varname2, varname3, varname4) \
2142 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2143 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2144 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2145 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2146 gcprolist = &gcpro4; }
2147
2148 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2149 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2150 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2151 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2152 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2153 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2154 gcprolist = &gcpro5; }
2155
2156 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2157 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2158 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2159 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2160 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2161 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2162 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
2163 gcprolist = &gcpro6; }
2164
2165 #define UNGCPRO (gcprolist = gcpro1.next)
2166
2167 #else
2168
2169 extern int gcpro_level;
2170
2171 #define GCPRO1(varname) \
2172 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
2173 gcpro1.level = gcpro_level++; \
2174 gcprolist = &gcpro1; }
2175
2176 #define GCPRO2(varname1, varname2) \
2177 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2178 gcpro1.level = gcpro_level; \
2179 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2180 gcpro2.level = gcpro_level++; \
2181 gcprolist = &gcpro2; }
2182
2183 #define GCPRO3(varname1, varname2, varname3) \
2184 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2185 gcpro1.level = gcpro_level; \
2186 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2187 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2188 gcpro3.level = gcpro_level++; \
2189 gcprolist = &gcpro3; }
2190
2191 #define GCPRO4(varname1, varname2, varname3, varname4) \
2192 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2193 gcpro1.level = gcpro_level; \
2194 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2195 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2196 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2197 gcpro4.level = gcpro_level++; \
2198 gcprolist = &gcpro4; }
2199
2200 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2201 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2202 gcpro1.level = gcpro_level; \
2203 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2204 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2205 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2206 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2207 gcpro5.level = gcpro_level++; \
2208 gcprolist = &gcpro5; }
2209
2210 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2211 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2212 gcpro1.level = gcpro_level; \
2213 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2214 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2215 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2216 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2217 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
2218 gcpro6.level = gcpro_level++; \
2219 gcprolist = &gcpro6; }
2220
2221 #define UNGCPRO \
2222 ((--gcpro_level != gcpro1.level) \
2223 ? (abort (), 0) \
2224 : ((gcprolist = gcpro1.next), 0))
2225
2226 #endif /* DEBUG_GCPRO */
2227 #endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
2228
2229
2230 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
2231 #define RETURN_UNGCPRO(expr) \
2232 do \
2233 { \
2234 Lisp_Object ret_ungc_val; \
2235 ret_ungc_val = (expr); \
2236 UNGCPRO; \
2237 return ret_ungc_val; \
2238 } \
2239 while (0)
2240
2241 /* Call staticpro (&var) to protect static variable `var'. */
2242
2243 void staticpro (Lisp_Object *);
2244 \f
2245 /* Declare a Lisp-callable function. The MAXARGS parameter has the same
2246 meaning as in the DEFUN macro, and is used to construct a prototype. */
2247 /* We can use the same trick as in the DEFUN macro to generate the
2248 appropriate prototype. */
2249 #define EXFUN(fnname, maxargs) \
2250 extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
2251
2252 /* Forward declarations for prototypes. */
2253 struct window;
2254 struct frame;
2255
2256 /* Defined in data.c */
2257 extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
2258 extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
2259 extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
2260 extern Lisp_Object Qvoid_variable, Qvoid_function;
2261 extern Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
2262 extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
2263 extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
2264 extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
2265 extern Lisp_Object Qtext_read_only;
2266
2267 extern Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
2268 extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
2269 extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
2270 extern Lisp_Object Qbuffer_or_string_p;
2271 extern Lisp_Object Qboundp, Qfboundp;
2272 extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
2273
2274 extern Lisp_Object Qcdr;
2275
2276 extern Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
2277 extern Lisp_Object Qoverflow_error, Qunderflow_error;
2278
2279 extern Lisp_Object Qfloatp;
2280 extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
2281
2282 extern Lisp_Object Qinteger;
2283
2284 extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
2285
2286 extern void circular_list_error (Lisp_Object) NO_RETURN;
2287 EXFUN (Finteractive_form, 1);
2288 EXFUN (Fbyteorder, 0);
2289
2290 /* Defined in frame.c */
2291 extern Lisp_Object Qframep;
2292
2293 EXFUN (Feq, 2);
2294 EXFUN (Fnull, 1);
2295 EXFUN (Flistp, 1);
2296 EXFUN (Fconsp, 1);
2297 EXFUN (Fatom, 1);
2298 EXFUN (Fnlistp, 1);
2299 EXFUN (Fintegerp, 1);
2300 EXFUN (Fnatnump, 1);
2301 EXFUN (Fsymbolp, 1);
2302 EXFUN (Fvectorp, 1);
2303 EXFUN (Fstringp, 1);
2304 EXFUN (Fmultibyte_string_p, 1);
2305 EXFUN (Farrayp, 1);
2306 EXFUN (Fsequencep, 1);
2307 EXFUN (Fbufferp, 1);
2308 EXFUN (Fmarkerp, 1);
2309 EXFUN (Fsubrp, 1);
2310 EXFUN (Fchar_or_string_p, 1);
2311 EXFUN (Finteger_or_marker_p, 1);
2312 EXFUN (Ffloatp, 1);
2313 EXFUN (Finteger_or_floatp, 1);
2314 EXFUN (Finteger_or_float_or_marker_p, 1);
2315
2316 EXFUN (Fcar, 1);
2317 EXFUN (Fcar_safe, 1);
2318 EXFUN (Fcdr, 1);
2319 EXFUN (Fcdr_safe, 1);
2320 EXFUN (Fsetcar, 2);
2321 EXFUN (Fsetcdr, 2);
2322 EXFUN (Fboundp, 1);
2323 EXFUN (Ffboundp, 1);
2324 EXFUN (Fmakunbound, 1);
2325 EXFUN (Ffmakunbound, 1);
2326 EXFUN (Fsymbol_function, 1);
2327 EXFUN (Fsymbol_plist, 1);
2328 EXFUN (Fsymbol_name, 1);
2329 extern Lisp_Object indirect_function (Lisp_Object);
2330 EXFUN (Findirect_function, 2);
2331 EXFUN (Ffset, 2);
2332 EXFUN (Fsetplist, 2);
2333 EXFUN (Fsymbol_value, 1);
2334 extern Lisp_Object find_symbol_value (Lisp_Object);
2335 EXFUN (Fset, 2);
2336 EXFUN (Fdefault_value, 1);
2337 EXFUN (Fset_default, 2);
2338 EXFUN (Fdefault_boundp, 1);
2339 EXFUN (Fmake_local_variable, 1);
2340 EXFUN (Flocal_variable_p, 2);
2341 EXFUN (Flocal_variable_if_set_p, 2);
2342
2343 EXFUN (Faref, 2);
2344 EXFUN (Faset, 3);
2345
2346 EXFUN (Fstring_to_number, 2);
2347 EXFUN (Fnumber_to_string, 1);
2348 EXFUN (Feqlsign, 2);
2349 EXFUN (Fgtr, 2);
2350 EXFUN (Flss, 2);
2351 EXFUN (Fgeq, 2);
2352 EXFUN (Fleq, 2);
2353 EXFUN (Fneq, 2);
2354 EXFUN (Fzerop, 1);
2355 EXFUN (Fplus, MANY);
2356 EXFUN (Fminus, MANY);
2357 EXFUN (Ftimes, MANY);
2358 EXFUN (Fquo, MANY);
2359 EXFUN (Frem, 2);
2360 EXFUN (Fmax, MANY);
2361 EXFUN (Fmin, MANY);
2362 EXFUN (Flogand, MANY);
2363 EXFUN (Flogior, MANY);
2364 EXFUN (Flogxor, MANY);
2365 EXFUN (Flognot, 1);
2366 EXFUN (Flsh, 2);
2367 EXFUN (Fash, 2);
2368
2369 EXFUN (Fadd1, 1);
2370 EXFUN (Fsub1, 1);
2371 EXFUN (Fmake_variable_buffer_local, 1);
2372
2373 extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
2374 extern Lisp_Object long_to_cons (unsigned long);
2375 extern unsigned long cons_to_long (Lisp_Object);
2376 extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN;
2377 extern void args_out_of_range_3 (Lisp_Object, Lisp_Object,
2378 Lisp_Object) NO_RETURN;
2379 extern Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object) NO_RETURN;
2380 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
2381 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int);
2382 extern void syms_of_data (void);
2383 extern void init_data (void);
2384 extern void swap_in_global_binding (struct Lisp_Symbol *);
2385
2386 /* Defined in cmds.c */
2387 EXFUN (Fend_of_line, 1);
2388 EXFUN (Fforward_char, 1);
2389 EXFUN (Fforward_line, 1);
2390 extern int internal_self_insert (int, int);
2391 extern void syms_of_cmds (void);
2392 extern void keys_of_cmds (void);
2393
2394 /* Defined in coding.c */
2395 EXFUN (Fcoding_system_p, 1);
2396 EXFUN (Fcoding_system_base, 1);
2397 EXFUN (Fcoding_system_eol_type, 1);
2398 EXFUN (Fcheck_coding_system, 1);
2399 EXFUN (Fcheck_coding_system, 1);
2400 EXFUN (Fread_coding_system, 2);
2401 EXFUN (Fread_non_nil_coding_system, 1);
2402 EXFUN (Ffind_operation_coding_system, MANY);
2403 EXFUN (Fupdate_coding_systems_internal, 0);
2404 EXFUN (Fencode_coding_string, 4);
2405 EXFUN (Fdecode_coding_string, 4);
2406 extern Lisp_Object detect_coding_system (const unsigned char *, EMACS_INT,
2407 EMACS_INT, int, int, Lisp_Object);
2408 extern void init_coding (void);
2409 extern void init_coding_once (void);
2410 extern void syms_of_coding (void);
2411
2412 /* Defined in character.c */
2413 extern void init_character_once (void);
2414 extern void syms_of_character (void);
2415 EXFUN (Funibyte_char_to_multibyte, 1);
2416
2417 /* Defined in charset.c */
2418 EXFUN (Fchar_bytes, 1);
2419 EXFUN (Fchar_width, 1);
2420 EXFUN (Fstring, MANY);
2421 extern EMACS_INT chars_in_text (const unsigned char *, EMACS_INT);
2422 extern EMACS_INT multibyte_chars_in_text (const unsigned char *, EMACS_INT);
2423 extern int multibyte_char_to_unibyte (int, Lisp_Object);
2424 extern int multibyte_char_to_unibyte_safe (int);
2425 extern Lisp_Object Qcharset;
2426 extern void init_charset (void);
2427 extern void init_charset_once (void);
2428 extern void syms_of_charset (void);
2429 /* Structure forward declarations. */
2430 struct charset;
2431
2432 /* Defined in composite.c */
2433 extern void syms_of_composite (void);
2434
2435 /* Defined in syntax.c */
2436 EXFUN (Fforward_word, 1);
2437 EXFUN (Fskip_chars_forward, 2);
2438 EXFUN (Fskip_chars_backward, 2);
2439 EXFUN (Fsyntax_table_p, 1);
2440 EXFUN (Fsyntax_table, 0);
2441 EXFUN (Fset_syntax_table, 1);
2442 extern void init_syntax_once (void);
2443 extern void syms_of_syntax (void);
2444
2445 /* Defined in fns.c */
2446 extern int use_dialog_box;
2447 extern int next_almost_prime (int);
2448 extern Lisp_Object larger_vector (Lisp_Object, int, Lisp_Object);
2449 extern void sweep_weak_hash_tables (void);
2450 extern Lisp_Object Qstring_lessp;
2451 extern Lisp_Object Vfeatures;
2452 extern Lisp_Object QCtest, QCweakness, Qequal, Qeq;
2453 unsigned sxhash (Lisp_Object, int);
2454 Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
2455 Lisp_Object, Lisp_Object, Lisp_Object,
2456 Lisp_Object);
2457 Lisp_Object copy_hash_table (struct Lisp_Hash_Table *);
2458 int hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, unsigned *);
2459 int hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
2460 unsigned);
2461 void hash_clear (struct Lisp_Hash_Table *);
2462 void init_weak_hash_tables (void);
2463 extern void init_fns (void);
2464 EXFUN (Fsxhash, 1);
2465 EXFUN (Fmake_hash_table, MANY);
2466 EXFUN (Fmakehash, 1);
2467 EXFUN (Fcopy_hash_table, 1);
2468 EXFUN (Fhash_table_count, 1);
2469 EXFUN (Fhash_table_rehash_size, 1);
2470 EXFUN (Fhash_table_rehash_threshold, 1);
2471 EXFUN (Fhash_table_size, 1);
2472 EXFUN (Fhash_table_test, 1);
2473 EXFUN (Fhash_table_weak, 1);
2474 EXFUN (Fhash_table_p, 1);
2475 EXFUN (Fclrhash, 1);
2476 EXFUN (Fgethash, 3);
2477 EXFUN (Fputhash, 3);
2478 EXFUN (Fremhash, 2);
2479 EXFUN (Fmaphash, 2);
2480 EXFUN (Fdefine_hash_table_test, 3);
2481
2482 EXFUN (Fidentity, 1);
2483 EXFUN (Frandom, 1);
2484 EXFUN (Flength, 1);
2485 EXFUN (Fsafe_length, 1);
2486 EXFUN (Fappend, MANY);
2487 EXFUN (Fconcat, MANY);
2488 EXFUN (Fvconcat, MANY);
2489 EXFUN (Fcopy_sequence, 1);
2490 EXFUN (Fstring_make_multibyte, 1);
2491 EXFUN (Fstring_make_unibyte, 1);
2492 EXFUN (Fstring_as_multibyte, 1);
2493 EXFUN (Fstring_as_unibyte, 1);
2494 EXFUN (Fstring_to_multibyte, 1);
2495 EXFUN (Fstring_to_unibyte, 1);
2496 EXFUN (Fsubstring, 3);
2497 extern Lisp_Object substring_both (Lisp_Object, int, int, int, int);
2498 EXFUN (Fnth, 2);
2499 EXFUN (Fnthcdr, 2);
2500 EXFUN (Fmemq, 2);
2501 EXFUN (Fassq, 2);
2502 EXFUN (Fassoc, 2);
2503 EXFUN (Felt, 2);
2504 EXFUN (Fmember, 2);
2505 EXFUN (Frassq, 2);
2506 EXFUN (Fdelq, 2);
2507 EXFUN (Fdelete, 2);
2508 EXFUN (Fsort, 2);
2509 EXFUN (Freverse, 1);
2510 EXFUN (Fnreverse, 1);
2511 EXFUN (Fget, 2);
2512 EXFUN (Fput, 3);
2513 EXFUN (Fequal, 2);
2514 EXFUN (Ffillarray, 2);
2515 EXFUN (Fnconc, MANY);
2516 EXFUN (Fmapcar, 2);
2517 EXFUN (Fmapconcat, 3);
2518 EXFUN (Fy_or_n_p, 1);
2519 extern Lisp_Object do_yes_or_no_p (Lisp_Object);
2520 EXFUN (Frequire, 3);
2521 EXFUN (Fprovide, 2);
2522 extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
2523 extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
2524 extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
2525 extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
2526 extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
2527 extern void clear_string_char_byte_cache (void);
2528 extern EMACS_INT string_char_to_byte (Lisp_Object, EMACS_INT);
2529 extern EMACS_INT string_byte_to_char (Lisp_Object, EMACS_INT);
2530 extern Lisp_Object string_make_multibyte (Lisp_Object);
2531 extern Lisp_Object string_to_multibyte (Lisp_Object);
2532 extern Lisp_Object string_make_unibyte (Lisp_Object);
2533 EXFUN (Fcopy_alist, 1);
2534 EXFUN (Fplist_get, 2);
2535 EXFUN (Fplist_put, 3);
2536 EXFUN (Fplist_member, 2);
2537 EXFUN (Frassoc, 2);
2538 EXFUN (Fstring_equal, 2);
2539 EXFUN (Fcompare_strings, 7);
2540 EXFUN (Fstring_lessp, 2);
2541 extern void syms_of_fns (void);
2542
2543 /* Defined in floatfns.c */
2544 extern double extract_float (Lisp_Object);
2545 EXFUN (Ffloat, 1);
2546 EXFUN (Ftruncate, 2);
2547 extern void init_floatfns (void);
2548 extern void syms_of_floatfns (void);
2549
2550 /* Defined in fringe.c */
2551 extern void syms_of_fringe (void);
2552 extern void init_fringe (void);
2553 extern void init_fringe_once (void);
2554
2555 /* Defined in image.c */
2556 EXFUN (Finit_image_library, 2);
2557 extern void syms_of_image (void);
2558 extern void init_image (void);
2559
2560 /* Defined in insdel.c */
2561 extern Lisp_Object Qinhibit_modification_hooks;
2562 extern void move_gap (EMACS_INT);
2563 extern void move_gap_both (EMACS_INT, EMACS_INT);
2564 extern void make_gap (EMACS_INT);
2565 extern EMACS_INT copy_text (const unsigned char *, unsigned char *,
2566 EMACS_INT, int, int);
2567 extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT);
2568 extern int count_combining_before (const unsigned char *,
2569 EMACS_INT, EMACS_INT, EMACS_INT);
2570 extern int count_combining_after (const unsigned char *,
2571 EMACS_INT, EMACS_INT, EMACS_INT);
2572 extern void insert (const unsigned char *, EMACS_INT);
2573 extern void insert_and_inherit (const unsigned char *, EMACS_INT);
2574 extern void insert_1 (const unsigned char *, EMACS_INT, int, int, int);
2575 extern void insert_1_both (const unsigned char *, EMACS_INT, EMACS_INT,
2576 int, int, int);
2577 extern void insert_from_gap (EMACS_INT, EMACS_INT);
2578 extern void insert_from_string (Lisp_Object, EMACS_INT, EMACS_INT,
2579 EMACS_INT, EMACS_INT, int);
2580 extern void insert_from_buffer (struct buffer *, EMACS_INT, EMACS_INT, int);
2581 extern void insert_char (int);
2582 extern void insert_string (const char *);
2583 extern void insert_before_markers (const unsigned char *, EMACS_INT);
2584 extern void insert_before_markers_and_inherit (const unsigned char *,
2585 EMACS_INT);
2586 extern void insert_from_string_before_markers (Lisp_Object, EMACS_INT,
2587 EMACS_INT, EMACS_INT,
2588 EMACS_INT, int);
2589 extern void del_range (EMACS_INT, EMACS_INT);
2590 extern Lisp_Object del_range_1 (EMACS_INT, EMACS_INT, int, int);
2591 extern void del_range_byte (EMACS_INT, EMACS_INT, int);
2592 extern void del_range_both (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, int);
2593 extern Lisp_Object del_range_2 (EMACS_INT, EMACS_INT,
2594 EMACS_INT, EMACS_INT, int);
2595 extern void modify_region (struct buffer *, EMACS_INT, EMACS_INT, int);
2596 extern void prepare_to_modify_buffer (EMACS_INT, EMACS_INT, EMACS_INT *);
2597 extern void signal_before_change (EMACS_INT, EMACS_INT, EMACS_INT *);
2598 extern void signal_after_change (EMACS_INT, EMACS_INT, EMACS_INT);
2599 extern void adjust_after_replace (EMACS_INT, EMACS_INT, Lisp_Object,
2600 EMACS_INT, EMACS_INT);
2601 extern void adjust_after_replace_noundo (EMACS_INT, EMACS_INT, EMACS_INT,
2602 EMACS_INT, EMACS_INT, EMACS_INT);
2603 extern void adjust_after_insert (EMACS_INT, EMACS_INT, EMACS_INT,
2604 EMACS_INT, EMACS_INT);
2605 extern void adjust_markers_for_delete (EMACS_INT, EMACS_INT,
2606 EMACS_INT, EMACS_INT);
2607 extern void replace_range (EMACS_INT, EMACS_INT, Lisp_Object, int, int, int);
2608 extern void replace_range_2 (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
2609 char *, EMACS_INT, EMACS_INT, int);
2610 extern void syms_of_insdel (void);
2611
2612 /* Defined in dispnew.c */
2613 extern Lisp_Object selected_frame;
2614 extern EMACS_INT baud_rate;
2615 EXFUN (Fding, 1);
2616 EXFUN (Fredraw_frame, 1);
2617 EXFUN (Fredraw_display, 0);
2618 EXFUN (Fsleep_for, 2);
2619 EXFUN (Fredisplay, 1);
2620 extern Lisp_Object sit_for (Lisp_Object, int, int);
2621 extern void init_display (void);
2622 extern void syms_of_display (void);
2623 extern void safe_bcopy (const char *, char *, int);
2624
2625 /* Defined in xdisp.c */
2626 extern Lisp_Object Qinhibit_point_motion_hooks;
2627 extern Lisp_Object Qinhibit_redisplay, Qdisplay;
2628 extern Lisp_Object Qinhibit_eval_during_redisplay;
2629 extern Lisp_Object Qmessage_truncate_lines;
2630 extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz;
2631 extern Lisp_Object Vmessage_log_max;
2632 extern int message_enable_multibyte;
2633 extern Lisp_Object echo_area_buffer[2];
2634 extern void check_message_stack (void);
2635 extern void setup_echo_area_for_printing (int);
2636 extern int push_message (void);
2637 extern Lisp_Object pop_message_unwind (Lisp_Object);
2638 extern Lisp_Object restore_message_unwind (Lisp_Object);
2639 extern void pop_message (void);
2640 extern void restore_message (void);
2641 extern Lisp_Object current_message (void);
2642 extern void set_message (const char *s, Lisp_Object, int, int);
2643 extern void clear_message (int, int);
2644 extern void message (/* char *, ... */);
2645 extern void message_nolog (/* char *, ... */);
2646 extern void message1 (char *);
2647 extern void message1_nolog (char *);
2648 extern void message2 (const char *, int, int);
2649 extern void message2_nolog (const char *, int, int);
2650 extern void message3 (Lisp_Object, int, int);
2651 extern void message3_nolog (Lisp_Object, int, int);
2652 extern void message_dolog (const char *, int, int, int);
2653 extern void message_with_string (char *, Lisp_Object, int);
2654 extern void message_log_maybe_newline (void);
2655 extern void update_echo_area (void);
2656 extern void truncate_echo_area (int);
2657 extern void redisplay (void);
2658 extern int check_point_in_composition
2659 (struct buffer *, int, struct buffer *, int);
2660 extern void redisplay_preserve_echo_area (int);
2661 extern void prepare_menu_bars (void);
2662
2663 void set_frame_cursor_types (struct frame *, Lisp_Object);
2664 extern void syms_of_xdisp (void);
2665 extern void init_xdisp (void);
2666 extern Lisp_Object safe_eval (Lisp_Object);
2667 extern int pos_visible_p (struct window *, int, int *,
2668 int *, int *, int *, int *, int *);
2669
2670 /* Defined in xsettings.c */
2671 extern void syms_of_xsettings (void);
2672
2673 /* Defined in vm-limit.c. */
2674 extern void memory_warnings (POINTER_TYPE *, void (*warnfun) ());
2675
2676 /* Defined in alloc.c */
2677 extern void check_pure_size (void);
2678 extern void allocate_string_data (struct Lisp_String *, int, int);
2679 extern void reset_malloc_hooks (void);
2680 extern void uninterrupt_malloc (void);
2681 extern void malloc_warning (char *);
2682 extern void memory_full (void) NO_RETURN;
2683 extern void buffer_memory_full (void) NO_RETURN;
2684 extern int survives_gc_p (Lisp_Object);
2685 extern void mark_object (Lisp_Object);
2686 extern Lisp_Object Vpurify_flag;
2687 extern Lisp_Object Vmemory_full;
2688 EXFUN (Fcons, 2);
2689 EXFUN (list1, 1);
2690 EXFUN (list2, 2);
2691 EXFUN (list3, 3);
2692 EXFUN (list4, 4);
2693 EXFUN (list5, 5);
2694 EXFUN (Flist, MANY);
2695 EXFUN (Fmake_list, 2);
2696 extern Lisp_Object allocate_misc (void);
2697 EXFUN (Fmake_vector, 2);
2698 EXFUN (Fvector, MANY);
2699 EXFUN (Fmake_symbol, 1);
2700 EXFUN (Fmake_marker, 0);
2701 EXFUN (Fmake_string, 2);
2702 extern Lisp_Object build_string (const char *);
2703 extern Lisp_Object make_string (const char *, int);
2704 extern Lisp_Object make_unibyte_string (const char *, int);
2705 extern Lisp_Object make_multibyte_string (const char *, int, int);
2706 extern Lisp_Object make_event_array (int, Lisp_Object *);
2707 extern Lisp_Object make_uninit_string (int);
2708 extern Lisp_Object make_uninit_multibyte_string (int, int);
2709 extern Lisp_Object make_string_from_bytes (const char *, int, int);
2710 extern Lisp_Object make_specified_string (const char *, int, int, int);
2711 EXFUN (Fpurecopy, 1);
2712 extern Lisp_Object make_pure_string (const char *, int, int, int);
2713 extern Lisp_Object make_pure_c_string (const char *data);
2714 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
2715 extern Lisp_Object make_pure_vector (EMACS_INT);
2716 EXFUN (Fgarbage_collect, 0);
2717 EXFUN (Fmake_byte_code, MANY);
2718 EXFUN (Fmake_bool_vector, 2);
2719 extern Lisp_Object Qchar_table_extra_slots;
2720 extern struct Lisp_Vector *allocate_vector (EMACS_INT);
2721 extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag);
2722 #define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
2723 ((typ*) \
2724 allocate_pseudovector \
2725 (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag))
2726 extern struct Lisp_Hash_Table *allocate_hash_table (void);
2727 extern struct window *allocate_window (void);
2728 extern struct frame *allocate_frame (void);
2729 extern struct Lisp_Process *allocate_process (void);
2730 extern struct terminal *allocate_terminal (void);
2731 extern int gc_in_progress;
2732 extern int abort_on_gc;
2733 extern Lisp_Object make_float (double);
2734 extern void display_malloc_warning (void);
2735 extern int inhibit_garbage_collection (void);
2736 extern Lisp_Object make_save_value (void *, int);
2737 extern void free_misc (Lisp_Object);
2738 extern void free_marker (Lisp_Object);
2739 extern void free_cons (struct Lisp_Cons *);
2740 extern void init_alloc_once (void);
2741 extern void init_alloc (void);
2742 extern void syms_of_alloc (void);
2743 extern struct buffer * allocate_buffer (void);
2744 extern int valid_lisp_object_p (Lisp_Object);
2745
2746 /* Defined in chartab.c */
2747 EXFUN (Fmake_char_table, 2);
2748 EXFUN (Fchar_table_parent, 1);
2749 EXFUN (Fset_char_table_parent, 2);
2750 EXFUN (Fchar_table_extra_slot, 2);
2751 EXFUN (Fset_char_table_extra_slot, 3);
2752 EXFUN (Fchar_table_range, 2);
2753 EXFUN (Fset_char_table_range, 3);
2754 EXFUN (Fset_char_table_default, 3);
2755 EXFUN (Foptimize_char_table, 2);
2756 EXFUN (Fmap_char_table, 2);
2757 extern Lisp_Object copy_char_table (Lisp_Object);
2758 extern Lisp_Object sub_char_table_ref (Lisp_Object, int);
2759 extern Lisp_Object char_table_ref (Lisp_Object, int);
2760 extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
2761 int *, int *);
2762 extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
2763 extern Lisp_Object char_table_set_range (Lisp_Object, int, int,
2764 Lisp_Object);
2765 extern int char_table_translate (Lisp_Object, int);
2766 extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
2767 Lisp_Object),
2768 Lisp_Object, Lisp_Object, Lisp_Object);
2769 extern void syms_of_chartab (void);
2770
2771 /* Defined in print.c */
2772 extern Lisp_Object Vprin1_to_string_buffer;
2773 extern void debug_print (Lisp_Object);
2774 EXFUN (Fprin1, 2);
2775 EXFUN (Fprin1_to_string, 2);
2776 EXFUN (Fprinc, 2);
2777 EXFUN (Fterpri, 1);
2778 EXFUN (Fprint, 2);
2779 EXFUN (Ferror_message_string, 1);
2780 extern Lisp_Object Vstandard_output, Qstandard_output;
2781 extern Lisp_Object Qexternal_debugging_output;
2782 extern void temp_output_buffer_setup (const char *);
2783 extern int print_level, print_escape_newlines;
2784 extern Lisp_Object Qprint_escape_newlines;
2785 extern void write_string (char *, int);
2786 extern void write_string_1 (char *, int, Lisp_Object);
2787 extern void print_error_message (Lisp_Object, Lisp_Object, char *, Lisp_Object);
2788 extern Lisp_Object internal_with_output_to_temp_buffer
2789 (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
2790 extern void float_to_string (unsigned char *, double);
2791 extern void syms_of_print (void);
2792
2793 /* Defined in doprnt.c */
2794 extern int doprnt (char *, int, char *, char *, int, char **);
2795
2796 /* Defined in lread.c */
2797 extern Lisp_Object Qvariable_documentation, Qstandard_input;
2798 extern Lisp_Object Vobarray, initial_obarray, Vstandard_input;
2799 EXFUN (Fread, 1);
2800 EXFUN (Fread_from_string, 3);
2801 EXFUN (Fintern, 2);
2802 EXFUN (Fintern_soft, 2);
2803 EXFUN (Fload, 5);
2804 EXFUN (Fget_load_suffixes, 0);
2805 EXFUN (Fget_file_char, 0);
2806 EXFUN (Fread_char, 3);
2807 EXFUN (Fread_event, 3);
2808 extern Lisp_Object read_filtered_event (int, int, int, int, Lisp_Object);
2809 EXFUN (Feval_region, 4);
2810 extern Lisp_Object check_obarray (Lisp_Object);
2811 extern Lisp_Object intern (const char *);
2812 extern Lisp_Object intern_c_string (const char *);
2813 extern Lisp_Object make_symbol (char *);
2814 extern Lisp_Object oblookup (Lisp_Object, const char *, int, int);
2815 #define LOADHIST_ATTACH(x) \
2816 do { \
2817 if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \
2818 } while (0)
2819 extern Lisp_Object Vcurrent_load_list;
2820 extern Lisp_Object Vload_history, Vload_suffixes, Vload_file_rep_suffixes;
2821 extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
2822 Lisp_Object *, Lisp_Object);
2823 extern int isfloat_string (char *, int);
2824 extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
2825 Lisp_Object);
2826 extern void dir_warning (char *, Lisp_Object);
2827 extern void close_load_descs (void);
2828 extern void init_obarray (void);
2829 extern void init_lread (void);
2830 extern void syms_of_lread (void);
2831
2832 /* Defined in eval.c */
2833 extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
2834 extern Lisp_Object Vinhibit_quit, Qinhibit_quit, Vquit_flag;
2835 extern Lisp_Object Vautoload_queue;
2836 extern Lisp_Object Vdebug_on_error;
2837 extern Lisp_Object Vsignaling_function;
2838 extern int handling_signal;
2839 extern int interactive_p (int);
2840
2841 /* To run a normal hook, use the appropriate function from the list below.
2842 The calling convention:
2843
2844 if (!NILP (Vrun_hooks))
2845 call1 (Vrun_hooks, Qmy_funny_hook);
2846
2847 should no longer be used. */
2848 extern Lisp_Object Vrun_hooks;
2849 EXFUN (Frun_hooks, MANY);
2850 EXFUN (Frun_hook_with_args, MANY);
2851 EXFUN (Frun_hook_with_args_until_success, MANY);
2852 EXFUN (Frun_hook_with_args_until_failure, MANY);
2853 extern Lisp_Object run_hook_list_with_args (Lisp_Object, int, Lisp_Object *);
2854 extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
2855 EXFUN (Fand, UNEVALLED);
2856 EXFUN (For, UNEVALLED);
2857 EXFUN (Fif, UNEVALLED);
2858 EXFUN (Fprogn, UNEVALLED);
2859 EXFUN (Fprog1, UNEVALLED);
2860 EXFUN (Fprog2, UNEVALLED);
2861 EXFUN (Fsetq, UNEVALLED);
2862 EXFUN (Fquote, UNEVALLED);
2863 EXFUN (Fuser_variable_p, 1);
2864 EXFUN (Finteractive_p, 0);
2865 EXFUN (Fdefun, UNEVALLED);
2866 EXFUN (Flet, UNEVALLED);
2867 EXFUN (FletX, UNEVALLED);
2868 EXFUN (Fwhile, UNEVALLED);
2869 EXFUN (Fcatch, UNEVALLED);
2870 EXFUN (Fthrow, 2) NO_RETURN;
2871 EXFUN (Funwind_protect, UNEVALLED);
2872 EXFUN (Fcondition_case, UNEVALLED);
2873 EXFUN (Fsignal, 2);
2874 extern void xsignal (Lisp_Object, Lisp_Object) NO_RETURN;
2875 extern void xsignal0 (Lisp_Object) NO_RETURN;
2876 extern void xsignal1 (Lisp_Object, Lisp_Object) NO_RETURN;
2877 extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
2878 extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
2879 extern void signal_error (char *, Lisp_Object) NO_RETURN;
2880 EXFUN (Fautoload, 5);
2881 EXFUN (Fcommandp, 2);
2882 EXFUN (Feval, 1);
2883 EXFUN (Fapply, MANY);
2884 EXFUN (Ffuncall, MANY);
2885 EXFUN (Fbacktrace, 0);
2886 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
2887 extern Lisp_Object call0 (Lisp_Object);
2888 extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
2889 extern Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object);
2890 extern Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2891 extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2892 extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2893 extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2894 extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2895 EXFUN (Fdo_auto_save, 2);
2896 extern Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
2897 extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
2898 extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
2899 extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
2900 extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
2901 extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
2902 extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (int, Lisp_Object *), int, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object));
2903 extern void specbind (Lisp_Object, Lisp_Object);
2904 extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
2905 extern Lisp_Object unbind_to (int, Lisp_Object);
2906 extern void error (/* char *, ... */) NO_RETURN;
2907 extern void do_autoload (Lisp_Object, Lisp_Object);
2908 extern Lisp_Object un_autoload (Lisp_Object);
2909 EXFUN (Ffetch_bytecode, 1);
2910 extern void init_eval_once (void);
2911 extern Lisp_Object safe_call (int, Lisp_Object *);
2912 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
2913 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
2914 extern void init_eval (void);
2915 extern void syms_of_eval (void);
2916
2917 /* Defined in editfns.c */
2918 EXFUN (Fpropertize, MANY);
2919 EXFUN (Fcurrent_message, 0);
2920 EXFUN (Fgoto_char, 1);
2921 EXFUN (Fpoint_min_marker, 0);
2922 EXFUN (Fpoint_max_marker, 0);
2923 EXFUN (Fpoint_min, 0);
2924 EXFUN (Fpoint_max, 0);
2925 EXFUN (Fpoint, 0);
2926 EXFUN (Fpoint_marker, 0);
2927 EXFUN (Fmark_marker, 0);
2928 EXFUN (Fline_beginning_position, 1);
2929 EXFUN (Fline_end_position, 1);
2930 EXFUN (Ffollowing_char, 0);
2931 EXFUN (Fprevious_char, 0);
2932 EXFUN (Fchar_after, 1);
2933 EXFUN (Finsert, MANY);
2934 EXFUN (Finsert_and_inherit, MANY);
2935 EXFUN (Finsert_before_markers, MANY);
2936 EXFUN (Finsert_buffer_substring, 3);
2937 EXFUN (Finsert_char, 3);
2938 extern void insert1 (Lisp_Object);
2939 EXFUN (Feolp, 0);
2940 EXFUN (Feobp, 0);
2941 EXFUN (Fbolp, 0);
2942 EXFUN (Fbobp, 0);
2943 EXFUN (Fformat, MANY);
2944 EXFUN (Fmessage, MANY);
2945 extern Lisp_Object format2 (char *, Lisp_Object, Lisp_Object);
2946 EXFUN (Fbuffer_substring, 2);
2947 EXFUN (Fbuffer_string, 0);
2948 extern Lisp_Object save_excursion_save (void);
2949 extern Lisp_Object save_restriction_save (void);
2950 extern Lisp_Object save_excursion_restore (Lisp_Object);
2951 extern Lisp_Object save_restriction_restore (Lisp_Object);
2952 EXFUN (Fchar_to_string, 1);
2953 EXFUN (Fdelete_region, 2);
2954 EXFUN (Fnarrow_to_region, 2);
2955 EXFUN (Fwiden, 0);
2956 EXFUN (Fuser_login_name, 1);
2957 EXFUN (Fsystem_name, 0);
2958 EXFUN (Fcurrent_time, 0);
2959 extern int clip_to_bounds (int, int, int);
2960 extern Lisp_Object make_buffer_string (int, int, int);
2961 extern Lisp_Object make_buffer_string_both (int, int, int, int, int);
2962 extern void init_editfns (void);
2963 extern void syms_of_editfns (void);
2964 extern Lisp_Object Vinhibit_field_text_motion;
2965 EXFUN (Fconstrain_to_field, 5);
2966 EXFUN (Ffield_string, 1);
2967 EXFUN (Fdelete_field, 1);
2968 EXFUN (Ffield_beginning, 3);
2969 EXFUN (Ffield_end, 3);
2970 EXFUN (Ffield_string_no_properties, 1);
2971 extern void set_time_zone_rule (char *);
2972
2973 /* Defined in buffer.c */
2974 extern int mouse_face_overlay_overlaps (Lisp_Object);
2975 extern void nsberror (Lisp_Object) NO_RETURN;
2976 EXFUN (Fset_buffer_multibyte, 1);
2977 EXFUN (Foverlay_start, 1);
2978 EXFUN (Foverlay_end, 1);
2979 EXFUN (Foverlay_buffer, 1);
2980 extern void adjust_overlays_for_insert (EMACS_INT, EMACS_INT);
2981 extern void adjust_overlays_for_delete (EMACS_INT, EMACS_INT);
2982 extern void fix_start_end_in_overlays (int, int);
2983 extern void report_overlay_modification (Lisp_Object, Lisp_Object, int,
2984 Lisp_Object, Lisp_Object, Lisp_Object);
2985 extern int overlay_touches_p (int);
2986 extern Lisp_Object Vbuffer_alist, Vinhibit_read_only;
2987 EXFUN (Fbuffer_list, 1);
2988 EXFUN (Fget_buffer, 1);
2989 EXFUN (Fget_buffer_create, 1);
2990 EXFUN (Fgenerate_new_buffer_name, 2);
2991 EXFUN (Fset_buffer, 1);
2992 EXFUN (set_buffer_if_live, 1);
2993 EXFUN (Fbarf_if_buffer_read_only, 0);
2994 EXFUN (Fcurrent_buffer, 0);
2995 EXFUN (Fswitch_to_buffer, 2);
2996 EXFUN (Fother_buffer, 3);
2997 EXFUN (Foverlay_get, 2);
2998 EXFUN (Fbuffer_modified_p, 1);
2999 EXFUN (Fset_buffer_modified_p, 1);
3000 EXFUN (Fkill_buffer, 1);
3001 EXFUN (Fkill_all_local_variables, 0);
3002 EXFUN (Fbuffer_disable_undo, 1);
3003 EXFUN (Fbuffer_enable_undo, 1);
3004 EXFUN (Ferase_buffer, 0);
3005 extern Lisp_Object Qoverlayp;
3006 extern Lisp_Object Qevaporate;
3007 extern Lisp_Object get_truename_buffer (Lisp_Object);
3008 extern struct buffer *all_buffers;
3009 EXFUN (Fprevious_overlay_change, 1);
3010 EXFUN (Fbuffer_file_name, 1);
3011 extern void init_buffer_once (void);
3012 extern void init_buffer (void);
3013 extern void syms_of_buffer (void);
3014 extern void keys_of_buffer (void);
3015
3016 /* Defined in marker.c */
3017
3018 EXFUN (Fmarker_position, 1);
3019 EXFUN (Fmarker_buffer, 1);
3020 EXFUN (Fcopy_marker, 2);
3021 EXFUN (Fset_marker, 3);
3022 extern int marker_position (Lisp_Object);
3023 extern int marker_byte_position (Lisp_Object);
3024 extern void clear_charpos_cache (struct buffer *);
3025 extern int charpos_to_bytepos (int);
3026 extern int buf_charpos_to_bytepos (struct buffer *, int);
3027 extern int buf_bytepos_to_charpos (struct buffer *, int);
3028 extern void unchain_marker (struct Lisp_Marker *marker);
3029 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
3030 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, int, int);
3031 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
3032 int, int);
3033 extern void syms_of_marker (void);
3034
3035 /* Defined in fileio.c */
3036
3037 extern Lisp_Object Qfile_error;
3038 EXFUN (Ffind_file_name_handler, 2);
3039 EXFUN (Ffile_name_as_directory, 1);
3040 EXFUN (Fmake_temp_name, 1);
3041 EXFUN (Fexpand_file_name, 2);
3042 EXFUN (Ffile_name_nondirectory, 1);
3043 EXFUN (Fsubstitute_in_file_name, 1);
3044 EXFUN (Ffile_symlink_p, 1);
3045 EXFUN (Fverify_visited_file_modtime, 1);
3046 EXFUN (Ffile_exists_p, 1);
3047 EXFUN (Ffile_name_absolute_p, 1);
3048 EXFUN (Fdirectory_file_name, 1);
3049 EXFUN (Ffile_name_directory, 1);
3050 extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
3051 EXFUN (Ffile_accessible_directory_p, 1);
3052 EXFUN (Funhandled_file_name_directory, 1);
3053 EXFUN (Ffile_directory_p, 1);
3054 EXFUN (Fwrite_region, 7);
3055 EXFUN (Ffile_readable_p, 1);
3056 EXFUN (Ffile_executable_p, 1);
3057 EXFUN (Fread_file_name, 6);
3058 extern Lisp_Object close_file_unwind (Lisp_Object);
3059 extern Lisp_Object restore_point_unwind (Lisp_Object);
3060 extern void report_file_error (const char *, Lisp_Object) NO_RETURN;
3061 extern int internal_delete_file (Lisp_Object);
3062 extern void syms_of_fileio (void);
3063 extern Lisp_Object make_temp_name (Lisp_Object, int);
3064 EXFUN (Fmake_symbolic_link, 3);
3065 extern Lisp_Object Qdelete_file;
3066
3067 /* Defined in abbrev.c */
3068
3069 extern void syms_of_abbrev (void);
3070
3071 /* Defined in search.c */
3072 extern void shrink_regexp_cache (void);
3073 EXFUN (Fstring_match, 3);
3074 extern void restore_search_regs (void);
3075 EXFUN (Fmatch_data, 3);
3076 EXFUN (Fset_match_data, 2);
3077 EXFUN (Fmatch_beginning, 1);
3078 EXFUN (Fmatch_end, 1);
3079 extern void record_unwind_save_match_data (void);
3080 EXFUN (Flooking_at, 1);
3081 extern int fast_string_match (Lisp_Object, Lisp_Object);
3082 extern int fast_c_string_match_ignore_case (Lisp_Object, const char *);
3083 extern int fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
3084 extern EMACS_INT fast_looking_at (Lisp_Object, EMACS_INT, EMACS_INT,
3085 EMACS_INT, EMACS_INT, Lisp_Object);
3086 extern int scan_buffer (int, EMACS_INT, EMACS_INT, int, int *, int);
3087 extern int scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
3088 int, int);
3089 extern int find_next_newline (EMACS_INT, int);
3090 extern int find_next_newline_no_quit (EMACS_INT, int);
3091 extern int find_before_next_newline (EMACS_INT, EMACS_INT, int);
3092 extern void syms_of_search (void);
3093 extern void clear_regexp_cache (void);
3094
3095 /* Defined in minibuf.c */
3096
3097 extern Lisp_Object last_minibuf_string;
3098 extern void choose_minibuf_frame (void);
3099 EXFUN (Fcompleting_read, 8);
3100 EXFUN (Fread_from_minibuffer, 7);
3101 EXFUN (Fread_variable, 2);
3102 EXFUN (Fread_buffer, 3);
3103 EXFUN (Fread_minibuffer, 2);
3104 EXFUN (Feval_minibuffer, 2);
3105 EXFUN (Fread_string, 5);
3106 EXFUN (Fread_no_blanks_input, 3);
3107 EXFUN (Fassoc_string, 3);
3108 extern Lisp_Object get_minibuffer (int);
3109 extern void temp_echo_area_glyphs (Lisp_Object);
3110 extern void init_minibuf_once (void);
3111 extern void syms_of_minibuf (void);
3112
3113 /* Defined in callint.c */
3114
3115 extern Lisp_Object Qminus, Qplus, Vcurrent_prefix_arg;
3116 extern Lisp_Object Vcommand_history;
3117 extern Lisp_Object Qcall_interactively, Qmouse_leave_buffer_hook;
3118 EXFUN (Fcall_interactively, 3);
3119 EXFUN (Fprefix_numeric_value, 1);
3120 extern void syms_of_callint (void);
3121
3122 /* Defined in casefiddle.c */
3123
3124 EXFUN (Fdowncase, 1);
3125 EXFUN (Fupcase, 1);
3126 EXFUN (Fcapitalize, 1);
3127 EXFUN (Fupcase_region, 2);
3128 EXFUN (Fupcase_initials, 1);
3129 EXFUN (Fupcase_initials_region, 2);
3130 extern void syms_of_casefiddle (void);
3131 extern void keys_of_casefiddle (void);
3132
3133 /* Defined in casetab.c */
3134
3135 EXFUN (Fset_case_table, 1);
3136 EXFUN (Fset_standard_case_table, 1);
3137 extern void init_casetab_once (void);
3138 extern void syms_of_casetab (void);
3139
3140 /* Defined in keyboard.c */
3141
3142 extern int echoing;
3143 extern Lisp_Object echo_message_buffer;
3144 extern struct kboard *echo_kboard;
3145 extern void cancel_echoing (void);
3146 extern Lisp_Object Qdisabled, QCfilter;
3147 extern Lisp_Object Vtty_erase_char, Vhelp_form, Vtop_level;
3148 extern Lisp_Object Vthrow_on_input;
3149 extern int input_pending;
3150 EXFUN (Fdiscard_input, 0);
3151 EXFUN (Frecursive_edit, 0);
3152 EXFUN (Ftop_level, 0);
3153 EXFUN (Fcommand_execute, 4);
3154 EXFUN (Finput_pending_p, 0);
3155 extern Lisp_Object menu_bar_items (Lisp_Object);
3156 extern Lisp_Object tool_bar_items (Lisp_Object, int *);
3157 extern Lisp_Object Qvertical_scroll_bar;
3158 extern void discard_mouse_events (void);
3159 EXFUN (Fevent_convert_list, 1);
3160 EXFUN (Fread_key_sequence, 5);
3161 EXFUN (Fset_input_interrupt_mode, 1);
3162 EXFUN (Fset_output_flow_control, 2);
3163 EXFUN (Fset_input_meta_mode, 2);
3164 EXFUN (Fset_quit_char, 1);
3165 EXFUN (Fset_input_mode, 4);
3166 extern Lisp_Object pending_funcalls;
3167 extern int detect_input_pending (void);
3168 extern int detect_input_pending_ignore_squeezables (void);
3169 extern int detect_input_pending_run_timers (int);
3170 extern void safe_run_hooks (Lisp_Object);
3171 extern void cmd_error_internal (Lisp_Object, char *);
3172 extern Lisp_Object command_loop_1 (void);
3173 extern Lisp_Object recursive_edit_1 (void);
3174 extern void record_auto_save (void);
3175 extern void init_keyboard (void);
3176 extern void syms_of_keyboard (void);
3177 extern void keys_of_keyboard (void);
3178 extern char *push_key_description (unsigned int, char *, int);
3179
3180
3181 /* Defined in indent.c */
3182 EXFUN (Fvertical_motion, 2);
3183 EXFUN (Findent_to, 2);
3184 EXFUN (Fcurrent_column, 0);
3185 EXFUN (Fmove_to_column, 2);
3186 extern double current_column (void);
3187 extern void invalidate_current_column (void);
3188 extern int indented_beyond_p (int, int, double);
3189 extern void syms_of_indent (void);
3190
3191 /* Defined in frame.c */
3192 #ifdef HAVE_WINDOW_SYSTEM
3193 extern Lisp_Object Vx_resource_name;
3194 extern Lisp_Object Vx_resource_class;
3195 #endif /* HAVE_WINDOW_SYSTEM */
3196 extern Lisp_Object Qvisible;
3197 extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
3198 extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
3199 extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
3200 extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
3201 extern Lisp_Object frame_buffer_predicate (Lisp_Object);
3202 EXFUN (Fframep, 1);
3203 EXFUN (Fselect_frame, 2);
3204 EXFUN (Fselected_frame, 0);
3205 EXFUN (Fwindow_frame, 1);
3206 EXFUN (Fframe_root_window, 1);
3207 EXFUN (Fframe_first_window, 1);
3208 EXFUN (Fframe_selected_window, 1);
3209 EXFUN (Fframe_list, 0);
3210 EXFUN (Fnext_frame, 2);
3211 EXFUN (Fdelete_frame, 2);
3212 EXFUN (Fset_mouse_position, 3);
3213 EXFUN (Fmake_frame_visible, 1);
3214 EXFUN (Fmake_frame_invisible, 2);
3215 EXFUN (Ficonify_frame, 1);
3216 EXFUN (Fframe_visible_p, 1);
3217 EXFUN (Fvisible_frame_list, 0);
3218 EXFUN (Fframe_parameter, 2);
3219 EXFUN (Fframe_parameters, 1);
3220 EXFUN (Fmodify_frame_parameters, 2);
3221 EXFUN (Fset_frame_height, 3);
3222 EXFUN (Fset_frame_width, 3);
3223 EXFUN (Fset_frame_size, 3);
3224 EXFUN (Fset_frame_position, 3);
3225 EXFUN (Fraise_frame, 1);
3226 EXFUN (Fredirect_frame_focus, 2);
3227 EXFUN (Fset_frame_selected_window, 3);
3228 extern Lisp_Object frame_buffer_list (Lisp_Object);
3229 extern void frames_discard_buffer (Lisp_Object);
3230 extern void set_frame_buffer_list (Lisp_Object, Lisp_Object);
3231 extern void frames_bury_buffer (Lisp_Object);
3232 extern void syms_of_frame (void);
3233
3234 /* Defined in emacs.c */
3235 extern Lisp_Object decode_env_path (char *, char *);
3236 extern Lisp_Object Vinvocation_name, Vinvocation_directory;
3237 extern Lisp_Object Vbefore_init_time, Vafter_init_time;
3238 extern Lisp_Object Vinstallation_directory;
3239 extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
3240 EXFUN (Fkill_emacs, 1);
3241 #if HAVE_SETLOCALE
3242 void fixup_locale (void);
3243 void synchronize_system_messages_locale (void);
3244 void synchronize_system_time_locale (void);
3245 #else
3246 #define setlocale(category, locale)
3247 #define fixup_locale()
3248 #define synchronize_system_messages_locale()
3249 #define synchronize_system_time_locale()
3250 #endif
3251 void shut_down_emacs (int, int, Lisp_Object);
3252 /* Nonzero means don't do interactive redisplay and don't change tty modes. */
3253 extern int noninteractive;
3254
3255 /* Nonzero means don't load X resources or Windows Registry settings. */
3256 extern int inhibit_x_resources;
3257
3258 /* Pipe used to send exit notification to the daemon parent at
3259 startup. */
3260 extern int daemon_pipe[2];
3261 #define IS_DAEMON (daemon_pipe[1] != 0)
3262
3263 /* Nonzero means don't do use window-system-specific display code. */
3264 extern int inhibit_window_system;
3265 /* Nonzero means that a filter or a sentinel is running. */
3266 extern int running_asynch_code;
3267
3268 /* Defined in process.c */
3269 EXFUN (Fget_process, 1);
3270 EXFUN (Fget_buffer_process, 1);
3271 EXFUN (Fprocessp, 1);
3272 EXFUN (Fprocess_status, 1);
3273 EXFUN (Fkill_process, 2);
3274 EXFUN (Fprocess_send_eof, 1);
3275 EXFUN (Fwaiting_for_user_input_p, 0);
3276 extern Lisp_Object Qprocessp;
3277 extern void kill_buffer_processes (Lisp_Object);
3278 extern int wait_reading_process_output (int, int, int, int,
3279 Lisp_Object,
3280 struct Lisp_Process *,
3281 int);
3282 extern void add_keyboard_wait_descriptor (int);
3283 extern void delete_keyboard_wait_descriptor (int);
3284 extern void add_gpm_wait_descriptor (int);
3285 extern void delete_gpm_wait_descriptor (int);
3286 extern void close_process_descs (void);
3287 extern void init_process (void);
3288 extern void syms_of_process (void);
3289 extern void setup_process_coding_systems (Lisp_Object);
3290
3291 /* Defined in callproc.c */
3292 extern Lisp_Object Vexec_path, Vexec_suffixes,
3293 Vexec_directory, Vdata_directory;
3294 extern Lisp_Object Vdoc_directory;
3295 EXFUN (Fcall_process, MANY);
3296 extern int child_setup (int, int, int, char **, int, Lisp_Object);
3297 extern void init_callproc_1 (void);
3298 extern void init_callproc (void);
3299 extern void set_initial_environment (void);
3300 extern void syms_of_callproc (void);
3301
3302 /* Defined in doc.c */
3303 extern Lisp_Object Vdoc_file_name;
3304 EXFUN (Fsubstitute_command_keys, 1);
3305 EXFUN (Fdocumentation, 2);
3306 EXFUN (Fdocumentation_property, 3);
3307 extern Lisp_Object read_doc_string (Lisp_Object);
3308 extern Lisp_Object get_doc_string (Lisp_Object, int, int);
3309 extern void syms_of_doc (void);
3310 extern int read_bytecode_char (int);
3311
3312 /* Defined in bytecode.c */
3313 extern Lisp_Object Qbytecode;
3314 EXFUN (Fbyte_code, 3);
3315 extern void syms_of_bytecode (void);
3316 extern struct byte_stack *byte_stack_list;
3317 extern void mark_byte_stack (void);
3318 extern void unmark_byte_stack (void);
3319
3320 /* Defined in macros.c */
3321 extern Lisp_Object Qexecute_kbd_macro;
3322 EXFUN (Fexecute_kbd_macro, 3);
3323 EXFUN (Fcancel_kbd_macro_events, 0);
3324 extern void init_macros (void);
3325 extern void syms_of_macros (void);
3326
3327 /* Defined in undo.c */
3328 extern Lisp_Object Qinhibit_read_only;
3329 EXFUN (Fundo_boundary, 0);
3330 extern void truncate_undo_list (struct buffer *);
3331 extern void record_marker_adjustment (Lisp_Object, int);
3332 extern void record_insert (int, int);
3333 extern void record_delete (int, Lisp_Object);
3334 extern void record_first_change (void);
3335 extern void record_change (int, int);
3336 extern void record_property_change (int, int, Lisp_Object, Lisp_Object,
3337 Lisp_Object);
3338 extern void syms_of_undo (void);
3339 extern Lisp_Object Vundo_outer_limit;
3340
3341 /* Defined in textprop.c */
3342 extern Lisp_Object Qfont, Qmouse_face;
3343 extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
3344 EXFUN (Fnext_single_property_change, 4);
3345 EXFUN (Fnext_single_char_property_change, 4);
3346 EXFUN (Fprevious_single_property_change, 4);
3347 EXFUN (Fget_text_property, 3);
3348 EXFUN (Fput_text_property, 5);
3349 EXFUN (Fget_text_property, 3);
3350 EXFUN (Fprevious_char_property_change, 2);
3351 EXFUN (Fnext_char_property_change, 2);
3352 extern void report_interval_modification (Lisp_Object, Lisp_Object);
3353 extern Lisp_Object next_single_char_property_change (Lisp_Object,
3354 Lisp_Object,
3355 Lisp_Object,
3356 Lisp_Object);
3357
3358 /* Defined in menu.c */
3359 extern void syms_of_menu (void);
3360
3361 /* Defined in xmenu.c */
3362 EXFUN (Fx_popup_menu, 2);
3363 EXFUN (Fx_popup_dialog, 3);
3364 extern void syms_of_xmenu (void);
3365
3366 /* Defined in termchar.h */
3367 struct tty_display_info;
3368
3369 /* Defined in termhooks.h */
3370 struct terminal;
3371
3372 /* Defined in sysdep.c */
3373 #ifndef HAVE_GET_CURRENT_DIR_NAME
3374 extern char *get_current_dir_name (void);
3375 #endif
3376 extern void stuff_char (char c);
3377 extern void init_sigio (int);
3378 extern void sys_subshell (void);
3379 extern void sys_suspend (void);
3380 extern void discard_tty_input (void);
3381 extern void init_sys_modes (struct tty_display_info *);
3382 extern void reset_sys_modes (struct tty_display_info *);
3383 extern void init_all_sys_modes (void);
3384 extern void reset_all_sys_modes (void);
3385 extern void wait_for_termination (int);
3386 extern void flush_pending_output (int);
3387 extern void child_setup_tty (int);
3388 extern void setup_pty (int);
3389 extern int set_window_size (int, int, int);
3390 extern void create_process (Lisp_Object, char **, Lisp_Object);
3391 extern int emacs_open (const char *, int, int);
3392 extern int emacs_close (int);
3393 extern int emacs_read (int, char *, unsigned int);
3394 extern int emacs_write (int, const char *, unsigned int);
3395
3396 /* Defined in filelock.c */
3397 EXFUN (Funlock_buffer, 0);
3398 EXFUN (Ffile_locked_p, 1);
3399 extern void unlock_all_files (void);
3400 extern void lock_file (Lisp_Object);
3401 extern void unlock_file (Lisp_Object);
3402 extern void unlock_buffer (struct buffer *);
3403 extern void syms_of_filelock (void);
3404 extern void init_filelock (void);
3405
3406 /* Defined in sound.c */
3407 extern void syms_of_sound (void);
3408 extern void init_sound (void);
3409
3410 /* Defined in category.c */
3411 extern void init_category_once (void);
3412 extern Lisp_Object char_category_set (int);
3413 extern void syms_of_category (void);
3414
3415 /* Defined in ccl.c */
3416 extern void syms_of_ccl (void);
3417
3418 /* Defined in dired.c */
3419 EXFUN (Ffile_attributes, 2);
3420 extern void syms_of_dired (void);
3421 extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
3422 Lisp_Object, Lisp_Object,
3423 int, Lisp_Object);
3424
3425 /* Defined in term.c */
3426 extern void syms_of_term (void);
3427 extern void fatal (const char *msgid, ...) NO_RETURN;
3428
3429 /* Defined in terminal.c */
3430 EXFUN (Fframe_terminal, 1);
3431 EXFUN (Fdelete_terminal, 2);
3432 extern void syms_of_terminal (void);
3433
3434 /* Defined in font.c */
3435 extern void syms_of_font (void);
3436 extern void init_font (void);
3437
3438 #ifdef HAVE_WINDOW_SYSTEM
3439 /* Defined in fontset.c */
3440 extern void syms_of_fontset (void);
3441 EXFUN (Fset_fontset_font, 5);
3442 EXFUN (Fnew_fontset, 2);
3443
3444 /* Defined in xfns.c, w32fns.c, or macfns.c */
3445 EXFUN (Fxw_display_color_p, 1);
3446 EXFUN (Fx_file_dialog, 5);
3447 EXFUN (Fx_focus_frame, 1);
3448 #endif
3449
3450 /* Defined in xfaces.c */
3451 EXFUN (Fclear_face_cache, 1);
3452 EXFUN (Fx_load_color_file, 1);
3453 extern void syms_of_xfaces (void);
3454
3455 #ifndef HAVE_GETLOADAVG
3456 /* Defined in getloadavg.c */
3457 extern int getloadavg (double *, int);
3458 #endif
3459
3460 #ifdef HAVE_X_WINDOWS
3461 /* Defined in xfns.c */
3462 extern void syms_of_xfns (void);
3463
3464 /* Defined in xsmfns.c */
3465 extern void syms_of_xsmfns (void);
3466
3467 /* Defined in xselect.c */
3468 EXFUN (Fx_send_client_event, 6);
3469 extern void syms_of_xselect (void);
3470
3471 /* Defined in xterm.c */
3472 extern void syms_of_xterm (void);
3473 #endif /* HAVE_X_WINDOWS */
3474
3475 #ifdef MSDOS
3476 /* Defined in msdos.c */
3477 EXFUN (Fmsdos_downcase_filename, 1);
3478 #endif
3479
3480 #ifdef HAVE_MENUS
3481 /* Defined in (x|w32)fns.c, nsfns.m... */
3482 extern int have_menus_p (void);
3483 #endif
3484
3485 #ifdef HAVE_DBUS
3486 /* Defined in dbusbind.c */
3487 int xd_pending_messages (void);
3488 void xd_read_queued_messages (void);
3489 void syms_of_dbusbind (void);
3490 #endif
3491 \f
3492 /* Nonzero means Emacs has already been initialized.
3493 Used during startup to detect startup of dumped Emacs. */
3494 extern int initialized;
3495
3496 extern int immediate_quit; /* Nonzero means ^G can quit instantly */
3497
3498 extern POINTER_TYPE *xmalloc (size_t);
3499 extern POINTER_TYPE *xrealloc (POINTER_TYPE *, size_t);
3500 extern void xfree (POINTER_TYPE *);
3501
3502 extern char *xstrdup (const char *);
3503
3504 extern char *egetenv (char *);
3505
3506 /* Set up the name of the machine we're running on. */
3507 extern void init_system_name (void);
3508
3509 /* Some systems (e.g., NT) use a different path separator than Unix,
3510 in addition to a device separator. Set the path separator
3511 to '/', and don't test for a device separator in IS_ANY_SEP. */
3512
3513 #define DIRECTORY_SEP '/'
3514 #ifndef IS_DIRECTORY_SEP
3515 #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
3516 #endif
3517 #ifndef IS_DEVICE_SEP
3518 #ifndef DEVICE_SEP
3519 #define IS_DEVICE_SEP(_c_) 0
3520 #else
3521 #define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
3522 #endif
3523 #endif
3524 #ifndef IS_ANY_SEP
3525 #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
3526 #endif
3527
3528 #define SWITCH_ENUM_CAST(x) (x)
3529
3530 /* Loop over Lisp list LIST. Signal an error if LIST is not a proper
3531 list, or if it contains circles.
3532
3533 HARE and TORTOISE should be the names of Lisp_Object variables, and
3534 N should be the name of an EMACS_INT variable declared in the
3535 function where the macro is used. Each nested loop should use
3536 its own variables.
3537
3538 In the loop body, HARE is set to each cons of LIST, and N is the
3539 length of the list processed so far. */
3540
3541 #define LIST_END_P(list, obj) \
3542 (NILP (obj) \
3543 ? 1 \
3544 : (CONSP (obj) \
3545 ? 0 \
3546 : (wrong_type_argument (Qlistp, (list))), 1))
3547
3548 #define FOREACH(hare, list, tortoise, n) \
3549 for (tortoise = hare = (list), n = 0; \
3550 !LIST_END_P (list, hare); \
3551 (hare = XCDR (hare), ++n, \
3552 ((n & 1) != 0 \
3553 ? (tortoise = XCDR (tortoise), \
3554 (EQ (hare, tortoise) \
3555 && (circular_list_error ((list)), 1))) \
3556 : 0)))
3557
3558 /* The ubiquitous min and max macros. */
3559
3560 #ifdef max
3561 #undef max
3562 #undef min
3563 #endif
3564 #define min(a, b) ((a) < (b) ? (a) : (b))
3565 #define max(a, b) ((a) > (b) ? (a) : (b))
3566
3567 /* We used to use `abs', but that clashes with system headers on some
3568 platforms, and using a name reserved by Standard C is a bad idea
3569 anyway. */
3570 #if !defined(eabs)
3571 #define eabs(x) ((x) < 0 ? -(x) : (x))
3572 #endif
3573
3574 /* Return a fixnum or float, depending on whether VAL fits in a Lisp
3575 fixnum. */
3576
3577 #define make_fixnum_or_float(val) \
3578 (FIXNUM_OVERFLOW_P (val) \
3579 ? make_float (val) \
3580 : make_number ((EMACS_INT)(val)))
3581
3582
3583 /* Checks the `cycle check' variable CHECK to see if it indicates that
3584 EL is part of a cycle; CHECK must be either Qnil or a value returned
3585 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3586 elements after which a cycle might be suspected; after that many
3587 elements, this macro begins consing in order to keep more precise
3588 track of elements.
3589
3590 Returns nil if a cycle was detected, otherwise a new value for CHECK
3591 that includes EL.
3592
3593 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3594 the caller should make sure that's ok. */
3595
3596 #define CYCLE_CHECK(check, el, suspicious) \
3597 (NILP (check) \
3598 ? make_number (0) \
3599 : (INTEGERP (check) \
3600 ? (XFASTINT (check) < (suspicious) \
3601 ? make_number (XFASTINT (check) + 1) \
3602 : Fcons (el, Qnil)) \
3603 : (!NILP (Fmemq ((el), (check))) \
3604 ? Qnil \
3605 : Fcons ((el), (check)))))
3606
3607
3608 /* SAFE_ALLOCA normally allocates memory on the stack, but if size is
3609 larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
3610
3611 #define MAX_ALLOCA 16*1024
3612
3613 extern Lisp_Object safe_alloca_unwind (Lisp_Object);
3614
3615 #define USE_SAFE_ALLOCA \
3616 int sa_count = SPECPDL_INDEX (), sa_must_free = 0
3617
3618 /* SAFE_ALLOCA allocates a simple buffer. */
3619
3620 #define SAFE_ALLOCA(buf, type, size) \
3621 do { \
3622 if ((size) < MAX_ALLOCA) \
3623 buf = (type) alloca (size); \
3624 else \
3625 { \
3626 buf = (type) xmalloc (size); \
3627 sa_must_free++; \
3628 record_unwind_protect (safe_alloca_unwind, \
3629 make_save_value (buf, 0)); \
3630 } \
3631 } while (0)
3632
3633 /* SAFE_FREE frees xmalloced memory and enables GC as needed. */
3634
3635 #define SAFE_FREE() \
3636 do { \
3637 if (sa_must_free) { \
3638 sa_must_free = 0; \
3639 unbind_to (sa_count, Qnil); \
3640 } \
3641 } while (0)
3642
3643
3644 /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
3645
3646 #define SAFE_ALLOCA_LISP(buf, nelt) \
3647 do { \
3648 int size_ = (nelt) * sizeof (Lisp_Object); \
3649 if (size_ < MAX_ALLOCA) \
3650 buf = (Lisp_Object *) alloca (size_); \
3651 else \
3652 { \
3653 Lisp_Object arg_; \
3654 buf = (Lisp_Object *) xmalloc (size_); \
3655 arg_ = make_save_value (buf, nelt); \
3656 XSAVE_VALUE (arg_)->dogc = 1; \
3657 sa_must_free++; \
3658 record_unwind_protect (safe_alloca_unwind, arg_); \
3659 } \
3660 } while (0)
3661
3662
3663 #endif /* EMACS_LISP_H */
3664
3665 /* arch-tag: 9b2ed020-70eb-47ac-94ee-e1c2a5107d5e
3666 (do not change this comment) */