Merge from trunk
[bpt/emacs.git] / src / lisp.h
1 /* Fundamental definitions for GNU Emacs Lisp interpreter.
2
3 Copyright (C) 1985-1987, 1993-1995, 1997-2012 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 #ifndef EMACS_LISP_H
21 #define EMACS_LISP_H
22
23 #include <setjmp.h>
24 #include <stdalign.h>
25 #include <stdarg.h>
26 #include <stdbool.h>
27 #include <stddef.h>
28 #include <inttypes.h>
29 #include <limits.h>
30
31 #include <intprops.h>
32
33 INLINE_HEADER_BEGIN
34 #ifndef LISP_INLINE
35 # define LISP_INLINE INLINE
36 #endif
37
38 /* The ubiquitous max and min macros. */
39 #undef min
40 #undef max
41 #define max(a, b) ((a) > (b) ? (a) : (b))
42 #define min(a, b) ((a) < (b) ? (a) : (b))
43
44 /* EMACS_INT - signed integer wide enough to hold an Emacs value
45 EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
46 pI - printf length modifier for EMACS_INT
47 EMACS_UINT - unsigned variant of EMACS_INT */
48 #ifndef EMACS_INT_MAX
49 # if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT
50 typedef long long int EMACS_INT;
51 typedef unsigned long long int EMACS_UINT;
52 # define EMACS_INT_MAX LLONG_MAX
53 # define pI "ll"
54 # elif INT_MAX < LONG_MAX
55 typedef long int EMACS_INT;
56 typedef unsigned long int EMACS_UINT;
57 # define EMACS_INT_MAX LONG_MAX
58 # define pI "l"
59 # else
60 typedef int EMACS_INT;
61 typedef unsigned int EMACS_UINT;
62 # define EMACS_INT_MAX INT_MAX
63 # define pI ""
64 # endif
65 #endif
66
67 /* Number of bits in some machine integer types. */
68 enum
69 {
70 BITS_PER_CHAR = CHAR_BIT,
71 BITS_PER_SHORT = CHAR_BIT * sizeof (short),
72 BITS_PER_INT = CHAR_BIT * sizeof (int),
73 BITS_PER_LONG = CHAR_BIT * sizeof (long int),
74 BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
75 };
76
77 /* printmax_t and uprintmax_t are types for printing large integers.
78 These are the widest integers that are supported for printing.
79 pMd etc. are conversions for printing them.
80 On C99 hosts, there's no problem, as even the widest integers work.
81 Fall back on EMACS_INT on pre-C99 hosts. */
82 #ifdef PRIdMAX
83 typedef intmax_t printmax_t;
84 typedef uintmax_t uprintmax_t;
85 # define pMd PRIdMAX
86 # define pMu PRIuMAX
87 #else
88 typedef EMACS_INT printmax_t;
89 typedef EMACS_UINT uprintmax_t;
90 # define pMd pI"d"
91 # define pMu pI"u"
92 #endif
93
94 /* Use pD to format ptrdiff_t values, which suffice for indexes into
95 buffers and strings. Emacs never allocates objects larger than
96 PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
97 In C99, pD can always be "t"; configure it here for the sake of
98 pre-C99 libraries such as glibc 2.0 and Solaris 8. */
99 #if PTRDIFF_MAX == INT_MAX
100 # define pD ""
101 #elif PTRDIFF_MAX == LONG_MAX
102 # define pD "l"
103 #elif PTRDIFF_MAX == LLONG_MAX
104 # define pD "ll"
105 #else
106 # define pD "t"
107 #endif
108
109 /* Extra internal type checking? */
110
111 /* Define an Emacs version of 'assert (COND)', since some
112 system-defined 'assert's are flaky. COND should be free of side
113 effects; it may or may not be evaluated. */
114 #ifndef ENABLE_CHECKING
115 # define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
116 #else /* ENABLE_CHECKING */
117
118 extern _Noreturn void die (const char *, const char *, int);
119
120 /* The suppress_checking variable is initialized to 0 in alloc.c. Set
121 it to 1 using a debugger to temporarily disable aborting on
122 detected internal inconsistencies or error conditions.
123
124 In some cases, a good compiler may be able to optimize away the
125 eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
126 STRINGP (x), but a particular use of XSTRING is invoked only after
127 testing that STRINGP (x) is true, making the test redundant. */
128 extern bool suppress_checking EXTERNALLY_VISIBLE;
129
130 # define eassert(cond) \
131 ((cond) || suppress_checking \
132 ? (void) 0 \
133 : die ("assertion failed: " # cond, __FILE__, __LINE__))
134 #endif /* ENABLE_CHECKING */
135 \f
136 /* Use the configure flag --enable-check-lisp-object-type to make
137 Lisp_Object use a struct type instead of the default int. The flag
138 causes CHECK_LISP_OBJECT_TYPE to be defined. */
139
140 /***** Select the tagging scheme. *****/
141 /* The following option controls the tagging scheme:
142 - USE_LSB_TAG means that we can assume the least 3 bits of pointers are
143 always 0, and we can thus use them to hold tag bits, without
144 restricting our addressing space.
145
146 If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
147 restricting our possible address range.
148
149 USE_LSB_TAG not only requires the least 3 bits of pointers returned by
150 malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
151 on the few static Lisp_Objects used: all the defsubr as well
152 as the two special buffers buffer_defaults and buffer_local_symbols. */
153
154 enum Lisp_Bits
155 {
156 /* Number of bits in a Lisp_Object tag. This can be used in #if,
157 and for GDB's sake also as a regular symbol. */
158 GCTYPEBITS =
159 #define GCTYPEBITS 3
160 GCTYPEBITS,
161
162 /* 2**GCTYPEBITS. This must also be a macro that expands to a
163 literal integer constant, for MSVC. */
164 GCALIGNMENT =
165 #define GCALIGNMENT 8
166 GCALIGNMENT,
167
168 /* Number of bits in a Lisp_Object value, not counting the tag. */
169 VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
170
171 /* Number of bits in a Lisp fixnum tag. */
172 INTTYPEBITS = GCTYPEBITS - 1,
173
174 /* Number of bits in a Lisp fixnum value, not counting the tag. */
175 FIXNUM_BITS = VALBITS + 1
176 };
177
178 #if GCALIGNMENT != 1 << GCTYPEBITS
179 # error "GCALIGNMENT and GCTYPEBITS are inconsistent"
180 #endif
181
182 /* The maximum value that can be stored in a EMACS_INT, assuming all
183 bits other than the type bits contribute to a nonnegative signed value.
184 This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
185 #define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
186
187 /* Unless otherwise specified, use USE_LSB_TAG on systems where: */
188 #ifndef USE_LSB_TAG
189 /* 1. We know malloc returns a multiple of 8. */
190 # if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
191 || defined DARWIN_OS || defined __sun)
192 /* 2. We can specify multiple-of-8 alignment on static variables. */
193 # ifdef alignas
194 /* 3. Pointers-as-ints exceed VAL_MAX.
195 On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
196 a. unnecessary, because the top bits of an EMACS_INT are unused, and
197 b. slower, because it typically requires extra masking.
198 So, default USE_LSB_TAG to 1 only on hosts where it might be useful. */
199 # if VAL_MAX < UINTPTR_MAX
200 # define USE_LSB_TAG 1
201 # endif
202 # endif
203 # endif
204 #endif
205 #ifdef USE_LSB_TAG
206 # undef USE_LSB_TAG
207 enum enum_USE_LSB_TAG { USE_LSB_TAG = 1 };
208 # define USE_LSB_TAG 1
209 #else
210 enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
211 # define USE_LSB_TAG 0
212 #endif
213
214 #ifndef alignas
215 # define alignas(alignment) /* empty */
216 # if USE_LSB_TAG
217 # error "USE_LSB_TAG requires alignas"
218 # endif
219 #endif
220
221
222 /* Define the fundamental Lisp data structures. */
223
224 /* This is the set of Lisp data types. */
225
226 /* Lisp integers use 2 tags, to give them one extra bit, thus
227 extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
228 static EMACS_INT const INTMASK = EMACS_INT_MAX >> (INTTYPEBITS - 1);
229 #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
230 #define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0)
231
232 /* Stolen from GDB. The only known compiler that doesn't support
233 enums in bitfields is MSVC. */
234 #ifdef _MSC_VER
235 #define ENUM_BF(TYPE) unsigned int
236 #else
237 #define ENUM_BF(TYPE) enum TYPE
238 #endif
239
240
241 enum Lisp_Type
242 {
243 /* Integer. XINT (obj) is the integer value. */
244 Lisp_Int0 = 0,
245 Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
246
247 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
248 Lisp_Symbol = 2,
249
250 /* Miscellaneous. XMISC (object) points to a union Lisp_Misc,
251 whose first member indicates the subtype. */
252 Lisp_Misc = 3,
253
254 /* String. XSTRING (object) points to a struct Lisp_String.
255 The length of the string, and its contents, are stored therein. */
256 Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
257
258 /* Vector of Lisp objects, or something resembling it.
259 XVECTOR (object) points to a struct Lisp_Vector, which contains
260 the size and contents. The size field also contains the type
261 information, if it's not a real vector object. */
262 Lisp_Vectorlike = 5,
263
264 /* Cons. XCONS (object) points to a struct Lisp_Cons. */
265 Lisp_Cons = 6,
266
267 Lisp_Float = 7,
268 };
269
270 /* This is the set of data types that share a common structure.
271 The first member of the structure is a type code from this set.
272 The enum values are arbitrary, but we'll use large numbers to make it
273 more likely that we'll spot the error if a random word in memory is
274 mistakenly interpreted as a Lisp_Misc. */
275 enum Lisp_Misc_Type
276 {
277 Lisp_Misc_Free = 0x5eab,
278 Lisp_Misc_Marker,
279 Lisp_Misc_Overlay,
280 Lisp_Misc_Save_Value,
281 /* Currently floats are not a misc type,
282 but let's define this in case we want to change that. */
283 Lisp_Misc_Float,
284 /* This is not a type code. It is for range checking. */
285 Lisp_Misc_Limit
286 };
287
288 /* These are the types of forwarding objects used in the value slot
289 of symbols for special built-in variables whose value is stored in
290 C variables. */
291 enum Lisp_Fwd_Type
292 {
293 Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
294 Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
295 Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
296 Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
297 Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
298 };
299
300 #ifdef CHECK_LISP_OBJECT_TYPE
301
302 typedef struct { EMACS_INT i; } Lisp_Object;
303
304 #define XLI(o) (o).i
305 LISP_INLINE Lisp_Object
306 XIL (EMACS_INT i)
307 {
308 Lisp_Object o = { i };
309 return o;
310 }
311
312 LISP_INLINE Lisp_Object
313 LISP_MAKE_RVALUE (Lisp_Object o)
314 {
315 return o;
316 }
317
318 #define LISP_INITIALLY_ZERO {0}
319
320 #undef CHECK_LISP_OBJECT_TYPE
321 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 };
322 #else /* CHECK_LISP_OBJECT_TYPE */
323
324 /* If a struct type is not wanted, define Lisp_Object as just a number. */
325
326 typedef EMACS_INT Lisp_Object;
327 #define XLI(o) (o)
328 #define XIL(i) (i)
329 #define LISP_MAKE_RVALUE(o) (0 + (o))
330 #define LISP_INITIALLY_ZERO 0
331 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 };
332 #endif /* CHECK_LISP_OBJECT_TYPE */
333
334 /* In the size word of a vector, this bit means the vector has been marked. */
335
336 static ptrdiff_t const ARRAY_MARK_FLAG
337 #define ARRAY_MARK_FLAG PTRDIFF_MIN
338 = ARRAY_MARK_FLAG;
339
340 /* In the size word of a struct Lisp_Vector, this bit means it's really
341 some other vector-like object. */
342 static ptrdiff_t const PSEUDOVECTOR_FLAG
343 #define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
344 = PSEUDOVECTOR_FLAG;
345
346 /* In a pseudovector, the size field actually contains a word with one
347 PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to
348 indicate the actual type.
349 We use a bitset, even tho only one of the bits can be set at any
350 particular time just so as to be able to use micro-optimizations such as
351 testing membership of a particular subset of pseudovectors in Fequal.
352 It is not crucial, but there are plenty of bits here, so why not do it? */
353 enum pvec_type
354 {
355 PVEC_NORMAL_VECTOR = 0, /* Unused! */
356 PVEC_FREE,
357 PVEC_PROCESS,
358 PVEC_FRAME,
359 PVEC_WINDOW,
360 PVEC_BOOL_VECTOR,
361 PVEC_BUFFER,
362 PVEC_HASH_TABLE,
363 PVEC_TERMINAL,
364 PVEC_WINDOW_CONFIGURATION,
365 PVEC_SUBR,
366 PVEC_OTHER,
367 /* These last 4 are special because we OR them in fns.c:internal_equal,
368 so they have to use a disjoint bit pattern:
369 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE
370 | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) */
371 PVEC_COMPILED = 0x10,
372 PVEC_CHAR_TABLE = 0x20,
373 PVEC_SUB_CHAR_TABLE = 0x30,
374 PVEC_FONT = 0x40
375 };
376
377 /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
378 which were stored in a Lisp_Object. */
379 #ifndef DATA_SEG_BITS
380 # define DATA_SEG_BITS 0
381 #endif
382 enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
383 #undef DATA_SEG_BITS
384
385 enum More_Lisp_Bits
386 {
387 DATA_SEG_BITS = gdb_DATA_SEG_BITS,
388
389 /* For convenience, we also store the number of elements in these bits.
390 Note that this size is not necessarily the memory-footprint size, but
391 only the number of Lisp_Object fields (that need to be traced by GC).
392 The distinction is used, e.g., by Lisp_Process, which places extra
393 non-Lisp_Object fields at the end of the structure. */
394 PSEUDOVECTOR_SIZE_BITS = 16,
395 PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
396 PVEC_TYPE_MASK = 0x0fff << PSEUDOVECTOR_SIZE_BITS,
397
398 /* Number of bits to put in each character in the internal representation
399 of bool vectors. This should not vary across implementations. */
400 BOOL_VECTOR_BITS_PER_CHAR = 8
401 };
402 \f
403 /* These macros extract various sorts of values from a Lisp_Object.
404 For example, if tem is a Lisp_Object whose type is Lisp_Cons,
405 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
406
407 /* Return a perfect hash of the Lisp_Object representation. */
408 #define XHASH(a) XLI (a)
409
410 #if USE_LSB_TAG
411
412 enum lsb_bits
413 {
414 TYPEMASK = (1 << GCTYPEBITS) - 1,
415 VALMASK = ~ TYPEMASK
416 };
417 #define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK))
418 #define XINT(a) (XLI (a) >> INTTYPEBITS)
419 #define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS)
420 #define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS)
421 #define make_lisp_ptr(ptr, type) \
422 (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \
423 XIL ((type) | (intptr_t) (ptr)))
424
425 #define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK))
426 #define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type)))
427
428 #else /* not USE_LSB_TAG */
429
430 static EMACS_INT const VALMASK
431 #define VALMASK VAL_MAX
432 = VALMASK;
433
434 #define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS))
435
436 /* For integers known to be positive, XFASTINT provides fast retrieval
437 and XSETFASTINT provides fast storage. This takes advantage of the
438 fact that Lisp integers have zero-bits in their tags. */
439 #define XFASTINT(a) (XLI (a) + 0)
440 #define XSETFASTINT(a, b) ((a) = XIL (b))
441
442 /* Extract the value of a Lisp_Object as a (un)signed integer. */
443
444 #define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS)
445 #define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK))
446 #define make_number(N) XIL ((EMACS_INT) (N) & INTMASK)
447
448 #define make_lisp_ptr(ptr, type) \
449 (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
450 + ((intptr_t) (ptr) & VALMASK)))
451
452 #if DATA_SEG_BITS
453 /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
454 which were stored in a Lisp_Object. */
455 #define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS))
456 #else
457 #define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK))
458 #endif
459
460 #endif /* not USE_LSB_TAG */
461
462 /* For integers known to be positive, XFASTINT sometimes provides
463 faster retrieval and XSETFASTINT provides faster storage.
464 If not, fallback on the non-accelerated path. */
465 #ifndef XFASTINT
466 # define XFASTINT(a) (XINT (a))
467 # define XSETFASTINT(a, b) (XSETINT (a, b))
468 #endif
469
470 /* Extract the pointer value of the Lisp object A, under the
471 assumption that A's type is TYPE. This is a fallback
472 implementation if nothing faster is available. */
473 #ifndef XUNTAG
474 # define XUNTAG(a, type) XPNTR (a)
475 #endif
476
477 #define EQ(x, y) (XHASH (x) == XHASH (y))
478
479 /* Largest and smallest representable fixnum values. These are the C
480 values. They are macros for use in static initializers, and
481 constants for visibility to GDB. */
482 static EMACS_INT const MOST_POSITIVE_FIXNUM =
483 #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
484 MOST_POSITIVE_FIXNUM;
485 static EMACS_INT const MOST_NEGATIVE_FIXNUM =
486 #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
487 MOST_NEGATIVE_FIXNUM;
488
489 /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
490 written this way so that it also works if I is of unsigned
491 type or if I is a NaN. */
492
493 #define FIXNUM_OVERFLOW_P(i) \
494 (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
495
496 LISP_INLINE ptrdiff_t
497 clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
498 {
499 return num < lower ? lower : num <= upper ? num : upper;
500 }
501
502 /* Extract a value or address from a Lisp_Object. */
503
504 #define XCONS(a) (eassert (CONSP (a)), \
505 (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
506 #define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
507 (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
508 #define XSTRING(a) (eassert (STRINGP (a)), \
509 (struct Lisp_String *) XUNTAG (a, Lisp_String))
510 #define XSYMBOL(a) (eassert (SYMBOLP (a)), \
511 (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
512 #define XFLOAT(a) (eassert (FLOATP (a)), \
513 (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
514
515 /* Misc types. */
516
517 #define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
518 #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any))
519 #define XMISCTYPE(a) (XMISCANY (a)->type)
520 #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
521 #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay))
522 #define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC (a)->u_save_value))
523
524 /* Forwarding object types. */
525
526 #define XFWDTYPE(a) (a->u_intfwd.type)
527 #define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd))
528 #define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd))
529 #define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd))
530 #define XBUFFER_OBJFWD(a) \
531 (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
532 #define XKBOARD_OBJFWD(a) \
533 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
534
535 /* Pseudovector types. */
536
537 #define XPROCESS(a) (eassert (PROCESSP (a)), \
538 (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
539 #define XWINDOW(a) (eassert (WINDOWP (a)), \
540 (struct window *) XUNTAG (a, Lisp_Vectorlike))
541 #define XTERMINAL(a) (eassert (TERMINALP (a)), \
542 (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
543 #define XSUBR(a) (eassert (SUBRP (a)), \
544 (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
545 #define XBUFFER(a) (eassert (BUFFERP (a)), \
546 (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
547 #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
548 (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
549 #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
550 ((struct Lisp_Sub_Char_Table *) \
551 XUNTAG (a, Lisp_Vectorlike)))
552 #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
553 ((struct Lisp_Bool_Vector *) \
554 XUNTAG (a, Lisp_Vectorlike)))
555
556 /* Construct a Lisp_Object from a value or address. */
557
558 #define XSETINT(a, b) ((a) = make_number (b))
559 #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
560 #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
561 #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
562 #define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol))
563 #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
564
565 /* Misc types. */
566
567 #define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
568 #define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
569
570 /* Pseudovector types. */
571
572 #define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE (v, header.size, code)
573 #define XSETTYPED_PVECTYPE(v, size_member, code) \
574 ((v)->size_member |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS))
575 #define XSETPVECTYPESIZE(v, code, sizeval) \
576 ((v)->header.size = (PSEUDOVECTOR_FLAG \
577 | ((code) << PSEUDOVECTOR_SIZE_BITS) \
578 | (sizeval)))
579
580 /* The cast to struct vectorlike_header * avoids aliasing issues. */
581 #define XSETPSEUDOVECTOR(a, b, code) \
582 XSETTYPED_PSEUDOVECTOR (a, b, \
583 (((struct vectorlike_header *) \
584 XUNTAG (a, Lisp_Vectorlike)) \
585 ->size), \
586 code)
587 #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
588 (XSETVECTOR (a, b), \
589 eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
590 == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS))))
591
592 #define XSETWINDOW_CONFIGURATION(a, b) \
593 (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
594 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
595 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
596 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
597 /* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */
598 #define XSETSUBR(a, b) \
599 XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
600 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
601 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
602 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
603 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
604 #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
605
606 /* Convenience macros for dealing with Lisp arrays. */
607
608 #define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
609 #define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
610 #define ASET(ARRAY, IDX, VAL) \
611 (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \
612 XVECTOR (ARRAY)->contents[IDX] = (VAL))
613
614 /* Convenience macros for dealing with Lisp strings. */
615
616 #define SDATA(string) (XSTRING (string)->data + 0)
617 #define SREF(string, index) (SDATA (string)[index] + 0)
618 #define SSET(string, index, new) (SDATA (string)[index] = (new))
619 #define SCHARS(string) (XSTRING (string)->size + 0)
620 #define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0)
621
622 /* Avoid "differ in sign" warnings. */
623 #define SSDATA(x) ((char *) SDATA (x))
624
625 #define STRING_SET_CHARS(string, newsize) \
626 (XSTRING (string)->size = (newsize))
627
628 #define STRING_COPYIN(string, index, new, count) \
629 memcpy (SDATA (string) + index, new, count)
630
631 /* Type checking. */
632
633 #define CHECK_TYPE(ok, Qxxxp, x) \
634 do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
635
636 /* Deprecated and will be removed soon. */
637
638 #define INTERNAL_FIELD(field) field ## _
639
640 /* See the macros in intervals.h. */
641
642 typedef struct interval *INTERVAL;
643
644 /* Complain if object is not string or buffer type. */
645 #define CHECK_STRING_OR_BUFFER(x) \
646 CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
647
648 struct Lisp_Cons
649 {
650 /* Car of this cons cell. */
651 Lisp_Object car;
652
653 union
654 {
655 /* Cdr of this cons cell. */
656 Lisp_Object cdr;
657
658 /* Used to chain conses on a free list. */
659 struct Lisp_Cons *chain;
660 } u;
661 };
662
663 /* Take the car or cdr of something known to be a cons cell. */
664 /* The _AS_LVALUE macros shouldn't be used outside of the minimal set
665 of code that has to know what a cons cell looks like. Other code not
666 part of the basic lisp implementation should assume that the car and cdr
667 fields are not accessible as lvalues. (What if we want to switch to
668 a copying collector someday? Cached cons cell field addresses may be
669 invalidated at arbitrary points.) */
670 #define XCAR_AS_LVALUE(c) (XCONS (c)->car)
671 #define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr)
672
673 /* Use these from normal code. */
674 #define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c))
675 #define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c))
676
677 /* Use these to set the fields of a cons cell.
678
679 Note that both arguments may refer to the same object, so 'n'
680 should not be read after 'c' is first modified. Also, neither
681 argument should be evaluated more than once; side effects are
682 especially common in the second argument. */
683 #define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n))
684 #define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n))
685
686 /* Take the car or cdr of something whose type is not known. */
687 #define CAR(c) \
688 (CONSP ((c)) ? XCAR ((c)) \
689 : NILP ((c)) ? Qnil \
690 : wrong_type_argument (Qlistp, (c)))
691
692 #define CDR(c) \
693 (CONSP ((c)) ? XCDR ((c)) \
694 : NILP ((c)) ? Qnil \
695 : wrong_type_argument (Qlistp, (c)))
696
697 /* Take the car or cdr of something whose type is not known. */
698 #define CAR_SAFE(c) \
699 (CONSP ((c)) ? XCAR ((c)) : Qnil)
700
701 #define CDR_SAFE(c) \
702 (CONSP ((c)) ? XCDR ((c)) : Qnil)
703
704 /* True if STR is a multibyte string. */
705 #define STRING_MULTIBYTE(STR) \
706 (XSTRING (STR)->size_byte >= 0)
707
708 /* Return the length in bytes of STR. */
709
710 #ifdef GC_CHECK_STRING_BYTES
711
712 struct Lisp_String;
713 extern ptrdiff_t string_bytes (struct Lisp_String *);
714 #define STRING_BYTES(S) string_bytes ((S))
715
716 #else /* not GC_CHECK_STRING_BYTES */
717
718 #define STRING_BYTES(STR) \
719 ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte)
720
721 #endif /* not GC_CHECK_STRING_BYTES */
722
723 /* An upper bound on the number of bytes in a Lisp string, not
724 counting the terminating null. This a tight enough bound to
725 prevent integer overflow errors that would otherwise occur during
726 string size calculations. A string cannot contain more bytes than
727 a fixnum can represent, nor can it be so long that C pointer
728 arithmetic stops working on the string plus its terminating null.
729 Although the actual size limit (see STRING_BYTES_MAX in alloc.c)
730 may be a bit smaller than STRING_BYTES_BOUND, calculating it here
731 would expose alloc.c internal details that we'd rather keep
732 private.
733
734 This is a macro for use in static initializers, and a constant for
735 visibility to GDB. The cast to ptrdiff_t ensures that
736 the macro is signed. */
737 static ptrdiff_t const STRING_BYTES_BOUND =
738 #define STRING_BYTES_BOUND \
739 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
740 STRING_BYTES_BOUND;
741
742 /* Mark STR as a unibyte string. */
743 #define STRING_SET_UNIBYTE(STR) \
744 do { if (EQ (STR, empty_multibyte_string)) \
745 (STR) = empty_unibyte_string; \
746 else XSTRING (STR)->size_byte = -1; } while (0)
747
748 /* Mark STR as a multibyte string. Assure that STR contains only
749 ASCII characters in advance. */
750 #define STRING_SET_MULTIBYTE(STR) \
751 do { if (EQ (STR, empty_unibyte_string)) \
752 (STR) = empty_multibyte_string; \
753 else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
754
755 /* In a string or vector, the sign bit of the `size' is the gc mark bit. */
756
757 struct Lisp_String
758 {
759 ptrdiff_t size;
760 ptrdiff_t size_byte;
761 INTERVAL intervals; /* Text properties in this string. */
762 unsigned char *data;
763 };
764
765 /* Header of vector-like objects. This documents the layout constraints on
766 vectors and pseudovectors other than struct Lisp_Subr. It also prevents
767 compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR
768 and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *,
769 because when two such pointers potentially alias, a compiler won't
770 incorrectly reorder loads and stores to their size fields. See
771 <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
772 struct vectorlike_header
773 {
774 /* This field contains various pieces of information:
775 - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
776 - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
777 vector (0) or a pseudovector (1).
778 - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
779 of slots) of the vector.
780 - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into
781 a "pvec type" tag held in PVEC_TYPE_MASK and a size held in the lowest
782 PSEUDOVECTOR_SIZE_BITS. That size normally indicates the number of
783 Lisp_Object slots at the beginning of the object that need to be
784 traced by the GC, tho some types use it slightly differently.
785 - E.g. if the pvec type is PVEC_FREE it means this is an unallocated
786 vector on a free-list and PSEUDOVECTOR_SIZE_BITS indicates its size
787 in bytes. */
788 ptrdiff_t size;
789
790 /* When the vector is allocated from a vector block, NBYTES is used
791 if the vector is not on a free list, and VECTOR is used otherwise.
792 For large vector-like objects, BUFFER or VECTOR is used as a pointer
793 to the next vector-like object. It is generally a buffer or a
794 Lisp_Vector alias, so for convenience it is a union instead of a
795 pointer: this way, one can write P->next.vector instead of ((struct
796 Lisp_Vector *) P->next). */
797 union {
798 /* This is only needed for small vectors that are not free because the
799 `size' field only gives us the number of Lisp_Object slots, whereas we
800 need to know the total size, including non-Lisp_Object data.
801 FIXME: figure out a way to store this info elsewhere so we can
802 finally get rid of this extra word of overhead. */
803 ptrdiff_t nbytes;
804 struct buffer *buffer;
805 /* FIXME: This can be removed: For large vectors, this field could be
806 placed *before* the vector itself. And for small vectors on a free
807 list, this field could be stored in the vector's bytes, since the
808 empty vector is handled specially anyway. */
809 struct Lisp_Vector *vector;
810 } next;
811 };
812
813 /* Regular vector is just a header plus array of Lisp_Objects. */
814
815 struct Lisp_Vector
816 {
817 struct vectorlike_header header;
818 Lisp_Object contents[1];
819 };
820
821 /* A boolvector is a kind of vectorlike, with contents are like a string. */
822
823 struct Lisp_Bool_Vector
824 {
825 /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
826 just the subtype information. */
827 struct vectorlike_header header;
828 /* This is the size in bits. */
829 EMACS_INT size;
830 /* This contains the actual bits, packed into bytes. */
831 unsigned char data[1];
832 };
833
834 /* Some handy constants for calculating sizes
835 and offsets, mostly of vectorlike objects. */
836
837 enum
838 {
839 header_size = offsetof (struct Lisp_Vector, contents),
840 bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
841 word_size = sizeof (Lisp_Object)
842 };
843
844 /* If a struct is made to look like a vector, this macro returns the length
845 of the shortest vector that would hold that struct. */
846
847 #define VECSIZE(type) \
848 ((sizeof (type) - header_size + word_size - 1) / word_size)
849
850 /* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
851 at the end and we need to compute the number of Lisp_Object fields (the
852 ones that the GC needs to trace). */
853
854 #define PSEUDOVECSIZE(type, nonlispfield) \
855 ((offsetof (type, nonlispfield) - header_size) / word_size)
856
857 /* A char-table is a kind of vectorlike, with contents are like a
858 vector but with a few other slots. For some purposes, it makes
859 sense to handle a char-table with type struct Lisp_Vector. An
860 element of a char table can be any Lisp objects, but if it is a sub
861 char-table, we treat it a table that contains information of a
862 specific range of characters. A sub char-table has the same
863 structure as a vector. A sub char table appears only in an element
864 of a char-table, and there's no way to access it directly from
865 Emacs Lisp program. */
866
867 #ifdef __GNUC__
868
869 #define CHAR_TABLE_REF_ASCII(CT, IDX) \
870 ({struct Lisp_Char_Table *_tbl = NULL; \
871 Lisp_Object _val; \
872 do { \
873 _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \
874 _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \
875 : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \
876 if (NILP (_val)) \
877 _val = _tbl->defalt; \
878 } while (NILP (_val) && ! NILP (_tbl->parent)); \
879 _val; })
880
881 #else /* not __GNUC__ */
882
883 #define CHAR_TABLE_REF_ASCII(CT, IDX) \
884 (! NILP (XCHAR_TABLE (CT)->ascii) \
885 ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
886 ? XCHAR_TABLE (CT)->ascii \
887 : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \
888 ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \
889 : char_table_ref ((CT), (IDX))) \
890 : char_table_ref ((CT), (IDX)))
891
892 #endif /* not __GNUC__ */
893
894 /* Compute A OP B, using the unsigned comparison operator OP. A and B
895 should be integer expressions. This is not the same as
896 mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
897 returns 1. For efficiency, prefer plain unsigned comparison if A
898 and B's sizes both fit (after integer promotion). */
899 #define UNSIGNED_CMP(a, op, b) \
900 (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \
901 ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \
902 : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
903
904 /* Nonzero iff C is an ASCII character. */
905 #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
906
907 /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
908 characters. Do not check validity of CT. */
909 #define CHAR_TABLE_REF(CT, IDX) \
910 (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \
911 : char_table_ref ((CT), (IDX)))
912
913 /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
914 8-bit European characters. Do not check validity of CT. */
915 #define CHAR_TABLE_SET(CT, IDX, VAL) \
916 (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
917 ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
918 : char_table_set (CT, IDX, VAL))
919
920 enum CHARTAB_SIZE_BITS
921 {
922 CHARTAB_SIZE_BITS_0 = 6,
923 CHARTAB_SIZE_BITS_1 = 4,
924 CHARTAB_SIZE_BITS_2 = 5,
925 CHARTAB_SIZE_BITS_3 = 7
926 };
927
928 extern const int chartab_size[4];
929
930 struct Lisp_Char_Table
931 {
932 /* HEADER.SIZE is the vector's size field, which also holds the
933 pseudovector type information. It holds the size, too.
934 The size counts the defalt, parent, purpose, ascii,
935 contents, and extras slots. */
936 struct vectorlike_header header;
937
938 /* This holds a default value,
939 which is used whenever the value for a specific character is nil. */
940 Lisp_Object defalt;
941
942 /* This points to another char table, which we inherit from when the
943 value for a specific character is nil. The `defalt' slot takes
944 precedence over this. */
945 Lisp_Object parent;
946
947 /* This is a symbol which says what kind of use this char-table is
948 meant for. */
949 Lisp_Object purpose;
950
951 /* The bottom sub char-table for characters of the range 0..127. It
952 is nil if none of ASCII character has a specific value. */
953 Lisp_Object ascii;
954
955 Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
956
957 /* These hold additional data. It is a vector. */
958 Lisp_Object extras[1];
959 };
960
961 struct Lisp_Sub_Char_Table
962 {
963 /* HEADER.SIZE is the vector's size field, which also holds the
964 pseudovector type information. It holds the size, too. */
965 struct vectorlike_header header;
966
967 /* Depth of this sub char-table. It should be 1, 2, or 3. A sub
968 char-table of depth 1 contains 16 elements, and each element
969 covers 4096 (128*32) characters. A sub char-table of depth 2
970 contains 32 elements, and each element covers 128 characters. A
971 sub char-table of depth 3 contains 128 elements, and each element
972 is for one character. */
973 Lisp_Object depth;
974
975 /* Minimum character covered by the sub char-table. */
976 Lisp_Object min_char;
977
978 /* Use set_sub_char_table_contents to set this. */
979 Lisp_Object contents[1];
980 };
981
982 /* This structure describes a built-in function.
983 It is generated by the DEFUN macro only.
984 defsubr makes it into a Lisp object.
985
986 This type is treated in most respects as a pseudovector,
987 but since we never dynamically allocate or free them,
988 we don't need a struct vectorlike_header and its 'next' field. */
989
990 struct Lisp_Subr
991 {
992 ptrdiff_t size;
993 union {
994 Lisp_Object (*a0) (void);
995 Lisp_Object (*a1) (Lisp_Object);
996 Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
997 Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object);
998 Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
999 Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1000 Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1001 Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1002 Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1003 Lisp_Object (*aUNEVALLED) (Lisp_Object args);
1004 Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
1005 } function;
1006 short min_args, max_args;
1007 const char *symbol_name;
1008 const char *intspec;
1009 const char *doc;
1010 };
1011
1012 /* This is the number of slots that every char table must have. This
1013 counts the ordinary slots and the top, defalt, parent, and purpose
1014 slots. */
1015 enum CHAR_TABLE_STANDARD_SLOTS
1016 {
1017 CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1
1018 };
1019
1020 /* Return the number of "extra" slots in the char table CT. */
1021
1022 #define CHAR_TABLE_EXTRA_SLOTS(CT) \
1023 (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
1024
1025 \f
1026 /***********************************************************************
1027 Symbols
1028 ***********************************************************************/
1029
1030 /* Interned state of a symbol. */
1031
1032 enum symbol_interned
1033 {
1034 SYMBOL_UNINTERNED = 0,
1035 SYMBOL_INTERNED = 1,
1036 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
1037 };
1038
1039 enum symbol_redirect
1040 {
1041 SYMBOL_PLAINVAL = 4,
1042 SYMBOL_VARALIAS = 1,
1043 SYMBOL_LOCALIZED = 2,
1044 SYMBOL_FORWARDED = 3
1045 };
1046
1047 struct Lisp_Symbol
1048 {
1049 unsigned gcmarkbit : 1;
1050
1051 /* Indicates where the value can be found:
1052 0 : it's a plain var, the value is in the `value' field.
1053 1 : it's a varalias, the value is really in the `alias' symbol.
1054 2 : it's a localized var, the value is in the `blv' object.
1055 3 : it's a forwarding variable, the value is in `forward'. */
1056 ENUM_BF (symbol_redirect) redirect : 3;
1057
1058 /* Non-zero means symbol is constant, i.e. changing its value
1059 should signal an error. If the value is 3, then the var
1060 can be changed, but only by `defconst'. */
1061 unsigned constant : 2;
1062
1063 /* Interned state of the symbol. This is an enumerator from
1064 enum symbol_interned. */
1065 unsigned interned : 2;
1066
1067 /* Non-zero means that this variable has been explicitly declared
1068 special (with `defvar' etc), and shouldn't be lexically bound. */
1069 unsigned declared_special : 1;
1070
1071 /* The symbol's name, as a Lisp string. */
1072 Lisp_Object name;
1073
1074 /* Value of the symbol or Qunbound if unbound. Which alternative of the
1075 union is used depends on the `redirect' field above. */
1076 union {
1077 Lisp_Object value;
1078 struct Lisp_Symbol *alias;
1079 struct Lisp_Buffer_Local_Value *blv;
1080 union Lisp_Fwd *fwd;
1081 } val;
1082
1083 /* Function value of the symbol or Qunbound if not fboundp. */
1084 Lisp_Object function;
1085
1086 /* The symbol's property list. */
1087 Lisp_Object plist;
1088
1089 /* Next symbol in obarray bucket, if the symbol is interned. */
1090 struct Lisp_Symbol *next;
1091 };
1092
1093 /* Value is name of symbol. */
1094
1095 #define SYMBOL_VAL(sym) \
1096 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value)
1097 #define SYMBOL_ALIAS(sym) \
1098 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
1099 #define SYMBOL_BLV(sym) \
1100 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
1101 #define SYMBOL_FWD(sym) \
1102 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
1103 #define SET_SYMBOL_VAL(sym, v) \
1104 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
1105 #define SET_SYMBOL_ALIAS(sym, v) \
1106 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
1107 #define SET_SYMBOL_BLV(sym, v) \
1108 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
1109 #define SET_SYMBOL_FWD(sym, v) \
1110 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
1111
1112 #define SYMBOL_NAME(sym) XSYMBOL (sym)->name
1113
1114 /* Value is non-zero if SYM is an interned symbol. */
1115
1116 #define SYMBOL_INTERNED_P(sym) \
1117 (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
1118
1119 /* Value is non-zero if SYM is interned in initial_obarray. */
1120
1121 #define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
1122 (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
1123
1124 /* Value is non-zero if symbol is considered a constant, i.e. its
1125 value cannot be changed (there is an exception for keyword symbols,
1126 whose value can be set to the keyword symbol itself). */
1127
1128 #define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
1129
1130 #define DEFSYM(sym, name) \
1131 do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
1132
1133 \f
1134 /***********************************************************************
1135 Hash Tables
1136 ***********************************************************************/
1137
1138 /* The structure of a Lisp hash table. */
1139
1140 struct Lisp_Hash_Table
1141 {
1142 /* This is for Lisp; the hash table code does not refer to it. */
1143 struct vectorlike_header header;
1144
1145 /* Function used to compare keys. */
1146 Lisp_Object test;
1147
1148 /* Nil if table is non-weak. Otherwise a symbol describing the
1149 weakness of the table. */
1150 Lisp_Object weak;
1151
1152 /* When the table is resized, and this is an integer, compute the
1153 new size by adding this to the old size. If a float, compute the
1154 new size by multiplying the old size with this factor. */
1155 Lisp_Object rehash_size;
1156
1157 /* Resize hash table when number of entries/ table size is >= this
1158 ratio, a float. */
1159 Lisp_Object rehash_threshold;
1160
1161 /* Vector of hash codes.. If hash[I] is nil, this means that that
1162 entry I is unused. */
1163 Lisp_Object hash;
1164
1165 /* Vector used to chain entries. If entry I is free, next[I] is the
1166 entry number of the next free item. If entry I is non-free,
1167 next[I] is the index of the next entry in the collision chain. */
1168 Lisp_Object next;
1169
1170 /* Index of first free entry in free list. */
1171 Lisp_Object next_free;
1172
1173 /* Bucket vector. A non-nil entry is the index of the first item in
1174 a collision chain. This vector's size can be larger than the
1175 hash table size to reduce collisions. */
1176 Lisp_Object index;
1177
1178 /* User-supplied hash function, or nil. */
1179 Lisp_Object user_hash_function;
1180
1181 /* User-supplied key comparison function, or nil. */
1182 Lisp_Object user_cmp_function;
1183
1184 /* Only the fields above are traced normally by the GC. The ones below
1185 `count' are special and are either ignored by the GC or traced in
1186 a special way (e.g. because of weakness). */
1187
1188 /* Number of key/value entries in the table. */
1189 ptrdiff_t count;
1190
1191 /* Vector of keys and values. The key of item I is found at index
1192 2 * I, the value is found at index 2 * I + 1.
1193 This is gc_marked specially if the table is weak. */
1194 Lisp_Object key_and_value;
1195
1196 /* Next weak hash table if this is a weak hash table. The head
1197 of the list is in weak_hash_tables. */
1198 struct Lisp_Hash_Table *next_weak;
1199
1200 /* C function to compare two keys. */
1201 bool (*cmpfn) (struct Lisp_Hash_Table *,
1202 Lisp_Object, EMACS_UINT,
1203 Lisp_Object, EMACS_UINT);
1204
1205 /* C function to compute hash code. */
1206 EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
1207 };
1208
1209
1210 #define XHASH_TABLE(OBJ) \
1211 ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
1212
1213 #define XSET_HASH_TABLE(VAR, PTR) \
1214 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
1215
1216 #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE)
1217
1218 #define CHECK_HASH_TABLE(x) \
1219 CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x)
1220
1221 /* Value is the key part of entry IDX in hash table H. */
1222
1223 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
1224
1225 /* Value is the value part of entry IDX in hash table H. */
1226
1227 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
1228
1229 /* Value is the index of the next entry following the one at IDX
1230 in hash table H. */
1231
1232 #define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX))
1233
1234 /* Value is the hash code computed for entry IDX in hash table H. */
1235
1236 #define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX))
1237
1238 /* Value is the index of the element in hash table H that is the
1239 start of the collision list at index IDX in the index vector of H. */
1240
1241 #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
1242
1243 /* Value is the size of hash table H. */
1244
1245 #define HASH_TABLE_SIZE(H) ASIZE ((H)->next)
1246
1247 /* Default size for hash tables if not specified. */
1248
1249 enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
1250
1251 /* Default threshold specifying when to resize a hash table. The
1252 value gives the ratio of current entries in the hash table and the
1253 size of the hash table. */
1254
1255 static double const DEFAULT_REHASH_THRESHOLD = 0.8;
1256
1257 /* Default factor by which to increase the size of a hash table. */
1258
1259 static double const DEFAULT_REHASH_SIZE = 1.5;
1260
1261 /* These structures are used for various misc types. */
1262
1263 struct Lisp_Misc_Any /* Supertype of all Misc types. */
1264 {
1265 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
1266 unsigned gcmarkbit : 1;
1267 int spacer : 15;
1268 };
1269
1270 struct Lisp_Marker
1271 {
1272 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */
1273 unsigned gcmarkbit : 1;
1274 int spacer : 13;
1275 /* This flag is temporarily used in the functions
1276 decode/encode_coding_object to record that the marker position
1277 must be adjusted after the conversion. */
1278 unsigned int need_adjustment : 1;
1279 /* 1 means normal insertion at the marker's position
1280 leaves the marker after the inserted text. */
1281 unsigned int insertion_type : 1;
1282 /* This is the buffer that the marker points into, or 0 if it points nowhere.
1283 Note: a chain of markers can contain markers pointing into different
1284 buffers (the chain is per buffer_text rather than per buffer, so it's
1285 shared between indirect buffers). */
1286 /* This is used for (other than NULL-checking):
1287 - Fmarker_buffer
1288 - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
1289 - unchain_marker: to find the list from which to unchain.
1290 - Fkill_buffer: to only unchain the markers of current indirect buffer.
1291 */
1292 struct buffer *buffer;
1293
1294 /* The remaining fields are meaningless in a marker that
1295 does not point anywhere. */
1296
1297 /* For markers that point somewhere,
1298 this is used to chain of all the markers in a given buffer. */
1299 /* We could remove it and use an array in buffer_text instead.
1300 That would also allow to preserve it ordered. */
1301 struct Lisp_Marker *next;
1302 /* This is the char position where the marker points. */
1303 ptrdiff_t charpos;
1304 /* This is the byte position.
1305 It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
1306 used to implement the functionality of markers, but rather to (ab)use
1307 markers as a cache for char<->byte mappings). */
1308 ptrdiff_t bytepos;
1309 };
1310
1311 /* START and END are markers in the overlay's buffer, and
1312 PLIST is the overlay's property list. */
1313 struct Lisp_Overlay
1314 /* An overlay's real data content is:
1315 - plist
1316 - buffer (really there are two buffer pointers, one per marker,
1317 and both points to the same buffer)
1318 - insertion type of both ends (per-marker fields)
1319 - start & start byte (of start marker)
1320 - end & end byte (of end marker)
1321 - next (singly linked list of overlays)
1322 - next fields of start and end markers (singly linked list of markers).
1323 I.e. 9words plus 2 bits, 3words of which are for external linked lists.
1324 */
1325 {
1326 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
1327 unsigned gcmarkbit : 1;
1328 int spacer : 15;
1329 struct Lisp_Overlay *next;
1330 Lisp_Object start;
1331 Lisp_Object end;
1332 Lisp_Object plist;
1333 };
1334
1335 /* Hold a C pointer for later use.
1336 This type of object is used in the arg to record_unwind_protect. */
1337 struct Lisp_Save_Value
1338 {
1339 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
1340 unsigned gcmarkbit : 1;
1341 int spacer : 14;
1342 /* If DOGC is set, POINTER is the address of a memory
1343 area containing INTEGER potential Lisp_Objects. */
1344 unsigned int dogc : 1;
1345 void *pointer;
1346 ptrdiff_t integer;
1347 };
1348
1349
1350 /* A miscellaneous object, when it's on the free list. */
1351 struct Lisp_Free
1352 {
1353 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
1354 unsigned gcmarkbit : 1;
1355 int spacer : 15;
1356 union Lisp_Misc *chain;
1357 };
1358
1359 /* To get the type field of a union Lisp_Misc, use XMISCTYPE.
1360 It uses one of these struct subtypes to get the type field. */
1361
1362 union Lisp_Misc
1363 {
1364 struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
1365 struct Lisp_Free u_free;
1366 struct Lisp_Marker u_marker;
1367 struct Lisp_Overlay u_overlay;
1368 struct Lisp_Save_Value u_save_value;
1369 };
1370
1371 /* Forwarding pointer to an int variable.
1372 This is allowed only in the value cell of a symbol,
1373 and it means that the symbol's value really lives in the
1374 specified int variable. */
1375 struct Lisp_Intfwd
1376 {
1377 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
1378 EMACS_INT *intvar;
1379 };
1380
1381 /* Boolean forwarding pointer to an int variable.
1382 This is like Lisp_Intfwd except that the ostensible
1383 "value" of the symbol is t if the int variable is nonzero,
1384 nil if it is zero. */
1385 struct Lisp_Boolfwd
1386 {
1387 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
1388 bool *boolvar;
1389 };
1390
1391 /* Forwarding pointer to a Lisp_Object variable.
1392 This is allowed only in the value cell of a symbol,
1393 and it means that the symbol's value really lives in the
1394 specified variable. */
1395 struct Lisp_Objfwd
1396 {
1397 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
1398 Lisp_Object *objvar;
1399 };
1400
1401 /* Like Lisp_Objfwd except that value lives in a slot in the
1402 current buffer. Value is byte index of slot within buffer. */
1403 struct Lisp_Buffer_Objfwd
1404 {
1405 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
1406 int offset;
1407 Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
1408 };
1409
1410 /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
1411 the symbol has buffer-local or frame-local bindings. (Exception:
1412 some buffer-local variables are built-in, with their values stored
1413 in the buffer structure itself. They are handled differently,
1414 using struct Lisp_Buffer_Objfwd.)
1415
1416 The `realvalue' slot holds the variable's current value, or a
1417 forwarding pointer to where that value is kept. This value is the
1418 one that corresponds to the loaded binding. To read or set the
1419 variable, you must first make sure the right binding is loaded;
1420 then you can access the value in (or through) `realvalue'.
1421
1422 `buffer' and `frame' are the buffer and frame for which the loaded
1423 binding was found. If those have changed, to make sure the right
1424 binding is loaded it is necessary to find which binding goes with
1425 the current buffer and selected frame, then load it. To load it,
1426 first unload the previous binding, then copy the value of the new
1427 binding into `realvalue' (or through it). Also update
1428 LOADED-BINDING to point to the newly loaded binding.
1429
1430 `local_if_set' indicates that merely setting the variable creates a
1431 local binding for the current buffer. Otherwise the latter, setting
1432 the variable does not do that; only make-local-variable does that. */
1433
1434 struct Lisp_Buffer_Local_Value
1435 {
1436 /* 1 means that merely setting the variable creates a local
1437 binding for the current buffer. */
1438 unsigned int local_if_set : 1;
1439 /* 1 means this variable can have frame-local bindings, otherwise, it is
1440 can have buffer-local bindings. The two cannot be combined. */
1441 unsigned int frame_local : 1;
1442 /* 1 means that the binding now loaded was found.
1443 Presumably equivalent to (defcell!=valcell). */
1444 unsigned int found : 1;
1445 /* If non-NULL, a forwarding to the C var where it should also be set. */
1446 union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
1447 /* The buffer or frame for which the loaded binding was found. */
1448 Lisp_Object where;
1449 /* A cons cell that holds the default value. It has the form
1450 (SYMBOL . DEFAULT-VALUE). */
1451 Lisp_Object defcell;
1452 /* The cons cell from `where's parameter alist.
1453 It always has the form (SYMBOL . VALUE)
1454 Note that if `forward' is non-nil, VALUE may be out of date.
1455 Also if the currently loaded binding is the default binding, then
1456 this is `eq'ual to defcell. */
1457 Lisp_Object valcell;
1458 };
1459
1460 /* Like Lisp_Objfwd except that value lives in a slot in the
1461 current kboard. */
1462 struct Lisp_Kboard_Objfwd
1463 {
1464 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */
1465 int offset;
1466 };
1467
1468 union Lisp_Fwd
1469 {
1470 struct Lisp_Intfwd u_intfwd;
1471 struct Lisp_Boolfwd u_boolfwd;
1472 struct Lisp_Objfwd u_objfwd;
1473 struct Lisp_Buffer_Objfwd u_buffer_objfwd;
1474 struct Lisp_Kboard_Objfwd u_kboard_objfwd;
1475 };
1476 \f
1477 /* Lisp floating point type. */
1478 struct Lisp_Float
1479 {
1480 union
1481 {
1482 double data;
1483 struct Lisp_Float *chain;
1484 } u;
1485 };
1486
1487 #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
1488 #define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n))
1489
1490 /* A character, declared with the following typedef, is a member
1491 of some character set associated with the current buffer. */
1492 #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */
1493 #define _UCHAR_T
1494 typedef unsigned char UCHAR;
1495 #endif
1496
1497 /* Meanings of slots in a Lisp_Compiled: */
1498
1499 enum Lisp_Compiled
1500 {
1501 COMPILED_ARGLIST = 0,
1502 COMPILED_BYTECODE = 1,
1503 COMPILED_CONSTANTS = 2,
1504 COMPILED_STACK_DEPTH = 3,
1505 COMPILED_DOC_STRING = 4,
1506 COMPILED_INTERACTIVE = 5
1507 };
1508
1509 /* Flag bits in a character. These also get used in termhooks.h.
1510 Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
1511 (MUlti-Lingual Emacs) might need 22 bits for the character value
1512 itself, so we probably shouldn't use any bits lower than 0x0400000. */
1513 enum char_bits
1514 {
1515 CHAR_ALT = 0x0400000,
1516 CHAR_SUPER = 0x0800000,
1517 CHAR_HYPER = 0x1000000,
1518 CHAR_SHIFT = 0x2000000,
1519 CHAR_CTL = 0x4000000,
1520 CHAR_META = 0x8000000,
1521
1522 CHAR_MODIFIER_MASK =
1523 CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META,
1524
1525 /* Actually, the current Emacs uses 22 bits for the character value
1526 itself. */
1527 CHARACTERBITS = 22
1528 };
1529
1530
1531
1532 \f
1533 /* The glyph datatype, used to represent characters on the display.
1534 It consists of a char code and a face id. */
1535
1536 typedef struct {
1537 int ch;
1538 int face_id;
1539 } GLYPH;
1540
1541 /* Return a glyph's character code. */
1542 #define GLYPH_CHAR(glyph) ((glyph).ch)
1543
1544 /* Return a glyph's face ID. */
1545 #define GLYPH_FACE(glyph) ((glyph).face_id)
1546
1547 #define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
1548 #define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
1549 #define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face))
1550
1551 /* Return 1 if GLYPH contains valid character code. */
1552 #define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph))
1553
1554
1555 /* Glyph Code from a display vector may either be an integer which
1556 encodes a char code in the lower CHARACTERBITS bits and a (very small)
1557 face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
1558
1559 #define GLYPH_CODE_P(gc) \
1560 (CONSP (gc) \
1561 ? (CHARACTERP (XCAR (gc)) \
1562 && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \
1563 : (RANGED_INTEGERP \
1564 (0, gc, \
1565 (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \
1566 ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \
1567 : TYPE_MAXIMUM (EMACS_INT)))))
1568
1569 /* The following are valid only if GLYPH_CODE_P (gc). */
1570
1571 #define GLYPH_CODE_CHAR(gc) \
1572 (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1))
1573
1574 #define GLYPH_CODE_FACE(gc) \
1575 (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS)
1576
1577 #define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
1578 do \
1579 { \
1580 if (CONSP (gc)) \
1581 SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
1582 else \
1583 SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
1584 (XINT (gc) >> CHARACTERBITS)); \
1585 } \
1586 while (0)
1587 \f
1588 /* Structure to hold mouse highlight data. This is here because other
1589 header files need it for defining struct x_output etc. */
1590 typedef struct {
1591 /* These variables describe the range of text currently shown in its
1592 mouse-face, together with the window they apply to. As long as
1593 the mouse stays within this range, we need not redraw anything on
1594 its account. Rows and columns are glyph matrix positions in
1595 MOUSE_FACE_WINDOW. */
1596 int mouse_face_beg_row, mouse_face_beg_col;
1597 int mouse_face_beg_x, mouse_face_beg_y;
1598 int mouse_face_end_row, mouse_face_end_col;
1599 int mouse_face_end_x, mouse_face_end_y;
1600 int mouse_face_past_end;
1601 Lisp_Object mouse_face_window;
1602 int mouse_face_face_id;
1603 Lisp_Object mouse_face_overlay;
1604
1605 /* 1 if a mouse motion event came and we didn't handle it right away because
1606 gc was in progress. */
1607 int mouse_face_deferred_gc;
1608
1609 /* FRAME and X, Y position of mouse when last checked for
1610 highlighting. X and Y can be negative or out of range for the frame. */
1611 struct frame *mouse_face_mouse_frame;
1612 int mouse_face_mouse_x, mouse_face_mouse_y;
1613
1614 /* Nonzero means defer mouse-motion highlighting. */
1615 int mouse_face_defer;
1616
1617 /* Nonzero means that the mouse highlight should not be shown. */
1618 int mouse_face_hidden;
1619
1620 int mouse_face_image_state;
1621 } Mouse_HLInfo;
1622 \f
1623 /* Data type checking. */
1624
1625 #define NILP(x) EQ (x, Qnil)
1626
1627 #define NUMBERP(x) (INTEGERP (x) || FLOATP (x))
1628 #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0)
1629
1630 #define RANGED_INTEGERP(lo, x, hi) \
1631 (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi))
1632 #define TYPE_RANGED_INTEGERP(type, x) \
1633 (TYPE_SIGNED (type) \
1634 ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \
1635 : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type)))
1636
1637 #define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
1638 #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
1639 #define MISCP(x) (XTYPE ((x)) == Lisp_Misc)
1640 #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike)
1641 #define STRINGP(x) (XTYPE ((x)) == Lisp_String)
1642 #define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
1643
1644 #define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
1645 #define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG))
1646 #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
1647 #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
1648 #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
1649
1650 #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
1651 #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
1652 #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
1653 #define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
1654 #define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
1655
1656 /* True if object X is a pseudovector whose code is CODE. The cast to struct
1657 vectorlike_header * avoids aliasing issues. */
1658 #define PSEUDOVECTORP(x, code) \
1659 TYPED_PSEUDOVECTORP (x, vectorlike_header, code)
1660
1661 #define PSEUDOVECTOR_TYPEP(v, code) \
1662 (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
1663 == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS)))
1664
1665 /* True if object X, with internal type struct T *, is a pseudovector whose
1666 code is CODE. */
1667 #define TYPED_PSEUDOVECTORP(x, t, code) \
1668 (VECTORLIKEP (x) \
1669 && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code))
1670
1671 /* Test for specific pseudovector types. */
1672 #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
1673 #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
1674 #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
1675 #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
1676 /* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */
1677 #define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
1678 #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
1679 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
1680 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
1681 #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
1682 #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
1683 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
1684
1685 /* Test for image (image . spec) */
1686 #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
1687
1688 /* Array types. */
1689
1690 #define ARRAYP(x) \
1691 (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
1692 \f
1693 #define CHECK_LIST(x) \
1694 CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
1695
1696 #define CHECK_LIST_CONS(x, y) \
1697 CHECK_TYPE (CONSP (x), Qlistp, y)
1698
1699 #define CHECK_LIST_END(x, y) \
1700 CHECK_TYPE (NILP (x), Qlistp, y)
1701
1702 #define CHECK_STRING(x) \
1703 CHECK_TYPE (STRINGP (x), Qstringp, x)
1704
1705 #define CHECK_STRING_CAR(x) \
1706 CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x))
1707
1708 #define CHECK_CONS(x) \
1709 CHECK_TYPE (CONSP (x), Qconsp, x)
1710
1711 #define CHECK_SYMBOL(x) \
1712 CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
1713
1714 #define CHECK_CHAR_TABLE(x) \
1715 CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x)
1716
1717 #define CHECK_VECTOR(x) \
1718 CHECK_TYPE (VECTORP (x), Qvectorp, x)
1719
1720 #define CHECK_VECTOR_OR_STRING(x) \
1721 CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x)
1722
1723 #define CHECK_ARRAY(x, Qxxxp) \
1724 CHECK_TYPE (ARRAYP (x), Qxxxp, x)
1725
1726 #define CHECK_VECTOR_OR_CHAR_TABLE(x) \
1727 CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x)
1728
1729 #define CHECK_BUFFER(x) \
1730 CHECK_TYPE (BUFFERP (x), Qbufferp, x)
1731
1732 #define CHECK_WINDOW(x) \
1733 CHECK_TYPE (WINDOWP (x), Qwindowp, x)
1734
1735 #define CHECK_WINDOW_CONFIGURATION(x) \
1736 CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
1737
1738 /* A window of any sort, leaf or interior, is "valid" if one of its
1739 buffer, vchild, or hchild members is non-nil. */
1740 #define CHECK_VALID_WINDOW(x) \
1741 CHECK_TYPE (WINDOWP (x) \
1742 && (!NILP (XWINDOW (x)->buffer) \
1743 || !NILP (XWINDOW (x)->vchild) \
1744 || !NILP (XWINDOW (x)->hchild)), \
1745 Qwindow_valid_p, x)
1746
1747 /* A window is "live" if and only if it shows a buffer. */
1748 #define CHECK_LIVE_WINDOW(x) \
1749 CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), \
1750 Qwindow_live_p, x)
1751
1752 #define CHECK_PROCESS(x) \
1753 CHECK_TYPE (PROCESSP (x), Qprocessp, x)
1754
1755 #define CHECK_SUBR(x) \
1756 CHECK_TYPE (SUBRP (x), Qsubrp, x)
1757
1758 #define CHECK_NUMBER(x) \
1759 CHECK_TYPE (INTEGERP (x), Qintegerp, x)
1760
1761 #define CHECK_NATNUM(x) \
1762 CHECK_TYPE (NATNUMP (x), Qwholenump, x)
1763
1764 #define CHECK_RANGED_INTEGER(x, lo, hi) \
1765 do { \
1766 CHECK_NUMBER (x); \
1767 if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \
1768 args_out_of_range_3 \
1769 (x, \
1770 make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \
1771 ? MOST_NEGATIVE_FIXNUM \
1772 : (lo)), \
1773 make_number (min (hi, MOST_POSITIVE_FIXNUM))); \
1774 } while (0)
1775 #define CHECK_TYPE_RANGED_INTEGER(type, x) \
1776 do { \
1777 if (TYPE_SIGNED (type)) \
1778 CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
1779 else \
1780 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
1781 } while (0)
1782
1783 #define CHECK_MARKER(x) \
1784 CHECK_TYPE (MARKERP (x), Qmarkerp, x)
1785
1786 #define CHECK_NUMBER_COERCE_MARKER(x) \
1787 do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
1788 else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
1789
1790 #define XFLOATINT(n) extract_float((n))
1791
1792 #define CHECK_FLOAT(x) \
1793 CHECK_TYPE (FLOATP (x), Qfloatp, x)
1794
1795 #define CHECK_NUMBER_OR_FLOAT(x) \
1796 CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x)
1797
1798 #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
1799 do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \
1800 else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
1801
1802 #define CHECK_OVERLAY(x) \
1803 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
1804
1805 /* Since we can't assign directly to the CAR or CDR fields of a cons
1806 cell, use these when checking that those fields contain numbers. */
1807 #define CHECK_NUMBER_CAR(x) \
1808 do { \
1809 Lisp_Object tmp = XCAR (x); \
1810 CHECK_NUMBER (tmp); \
1811 XSETCAR ((x), tmp); \
1812 } while (0)
1813
1814 #define CHECK_NUMBER_CDR(x) \
1815 do { \
1816 Lisp_Object tmp = XCDR (x); \
1817 CHECK_NUMBER (tmp); \
1818 XSETCDR ((x), tmp); \
1819 } while (0)
1820
1821 #define CHECK_NATNUM_CAR(x) \
1822 do { \
1823 Lisp_Object tmp = XCAR (x); \
1824 CHECK_NATNUM (tmp); \
1825 XSETCAR ((x), tmp); \
1826 } while (0)
1827
1828 #define CHECK_NATNUM_CDR(x) \
1829 do { \
1830 Lisp_Object tmp = XCDR (x); \
1831 CHECK_NATNUM (tmp); \
1832 XSETCDR ((x), tmp); \
1833 } while (0)
1834 \f
1835 /* Define a built-in function for calling from Lisp.
1836 `lname' should be the name to give the function in Lisp,
1837 as a null-terminated C string.
1838 `fnname' should be the name of the function in C.
1839 By convention, it starts with F.
1840 `sname' should be the name for the C constant structure
1841 that records information on this function for internal use.
1842 By convention, it should be the same as `fnname' but with S instead of F.
1843 It's too bad that C macros can't compute this from `fnname'.
1844 `minargs' should be a number, the minimum number of arguments allowed.
1845 `maxargs' should be a number, the maximum number of arguments allowed,
1846 or else MANY or UNEVALLED.
1847 MANY means pass a vector of evaluated arguments,
1848 in the form of an integer number-of-arguments
1849 followed by the address of a vector of Lisp_Objects
1850 which contains the argument values.
1851 UNEVALLED means pass the list of unevaluated arguments
1852 `intspec' says how interactive arguments are to be fetched.
1853 If the string starts with a `(', `intspec' is evaluated and the resulting
1854 list is the list of arguments.
1855 If it's a string that doesn't start with `(', the value should follow
1856 the one of the doc string for `interactive'.
1857 A null string means call interactively with no arguments.
1858 `doc' is documentation for the user. */
1859
1860 /* This version of DEFUN declares a function prototype with the right
1861 arguments, so we can catch errors with maxargs at compile-time. */
1862 #ifdef _MSC_VER
1863 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
1864 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
1865 static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
1866 { (PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS) \
1867 | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
1868 { (Lisp_Object (__cdecl *)(void))fnname }, \
1869 minargs, maxargs, lname, intspec, 0}; \
1870 Lisp_Object fnname
1871 #else /* not _MSC_VER */
1872 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
1873 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
1874 static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
1875 { PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS, \
1876 { .a ## maxargs = fnname }, \
1877 minargs, maxargs, lname, intspec, 0}; \
1878 Lisp_Object fnname
1879 #endif
1880
1881 /* Note that the weird token-substitution semantics of ANSI C makes
1882 this work for MANY and UNEVALLED. */
1883 #define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
1884 #define DEFUN_ARGS_UNEVALLED (Lisp_Object)
1885 #define DEFUN_ARGS_0 (void)
1886 #define DEFUN_ARGS_1 (Lisp_Object)
1887 #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
1888 #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
1889 #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1890 #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1891 Lisp_Object)
1892 #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1893 Lisp_Object, Lisp_Object)
1894 #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1895 Lisp_Object, Lisp_Object, Lisp_Object)
1896 #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1897 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1898
1899 /* Non-zero if OBJ is a Lisp function. */
1900 #define FUNCTIONP(OBJ) functionp(OBJ)
1901
1902 /* defsubr (Sname);
1903 is how we define the symbol for function `name' at start-up time. */
1904 extern void defsubr (struct Lisp_Subr *);
1905
1906 enum maxargs
1907 {
1908 MANY = -2,
1909 UNEVALLED = -1
1910 };
1911
1912 extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1913 extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1914 extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *);
1915 extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
1916 extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
1917
1918 /* Macros we use to define forwarded Lisp variables.
1919 These are used in the syms_of_FILENAME functions.
1920
1921 An ordinary (not in buffer_defaults, per-buffer, or per-keyboard)
1922 lisp variable is actually a field in `struct emacs_globals'. The
1923 field's name begins with "f_", which is a convention enforced by
1924 these macros. Each such global has a corresponding #define in
1925 globals.h; the plain name should be used in the code.
1926
1927 E.g., the global "cons_cells_consed" is declared as "int
1928 f_cons_cells_consed" in globals.h, but there is a define:
1929
1930 #define cons_cells_consed globals.f_cons_cells_consed
1931
1932 All C code uses the `cons_cells_consed' name. This is all done
1933 this way to support indirection for multi-threaded Emacs. */
1934
1935 #define DEFVAR_LISP(lname, vname, doc) \
1936 do { \
1937 static struct Lisp_Objfwd o_fwd; \
1938 defvar_lisp (&o_fwd, lname, &globals.f_ ## vname); \
1939 } while (0)
1940 #define DEFVAR_LISP_NOPRO(lname, vname, doc) \
1941 do { \
1942 static struct Lisp_Objfwd o_fwd; \
1943 defvar_lisp_nopro (&o_fwd, lname, &globals.f_ ## vname); \
1944 } while (0)
1945 #define DEFVAR_BOOL(lname, vname, doc) \
1946 do { \
1947 static struct Lisp_Boolfwd b_fwd; \
1948 defvar_bool (&b_fwd, lname, &globals.f_ ## vname); \
1949 } while (0)
1950 #define DEFVAR_INT(lname, vname, doc) \
1951 do { \
1952 static struct Lisp_Intfwd i_fwd; \
1953 defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
1954 } while (0)
1955
1956 #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \
1957 do { \
1958 static struct Lisp_Objfwd o_fwd; \
1959 defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \
1960 } while (0)
1961
1962 #define DEFVAR_KBOARD(lname, vname, doc) \
1963 do { \
1964 static struct Lisp_Kboard_Objfwd ko_fwd; \
1965 defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
1966 } while (0)
1967 \f
1968 /* Save and restore the instruction and environment pointers,
1969 without affecting the signal mask. */
1970
1971 #ifdef HAVE__SETJMP
1972 typedef jmp_buf sys_jmp_buf;
1973 # define sys_setjmp(j) _setjmp (j)
1974 # define sys_longjmp(j, v) _longjmp (j, v)
1975 #elif defined HAVE_SIGSETJMP
1976 typedef sigjmp_buf sys_jmp_buf;
1977 # define sys_setjmp(j) sigsetjmp (j, 0)
1978 # define sys_longjmp(j, v) siglongjmp (j, v)
1979 #else
1980 /* A platform that uses neither _longjmp nor siglongjmp; assume
1981 longjmp does not affect the sigmask. */
1982 typedef jmp_buf sys_jmp_buf;
1983 # define sys_setjmp(j) setjmp (j)
1984 # define sys_longjmp(j, v) longjmp (j, v)
1985 #endif
1986
1987 \f
1988 /* Structure for recording Lisp call stack for backtrace purposes. */
1989
1990 /* The special binding stack holds the outer values of variables while
1991 they are bound by a function application or a let form, stores the
1992 code to be executed for Lisp unwind-protect forms, and stores the C
1993 functions to be called for record_unwind_protect.
1994
1995 If func is non-zero, undoing this binding applies func to old_value;
1996 This implements record_unwind_protect.
1997
1998 Otherwise, the element is a variable binding.
1999
2000 If the symbol field is a symbol, it is an ordinary variable binding.
2001
2002 Otherwise, it should be a structure (SYMBOL WHERE . CURRENT-BUFFER),
2003 which means having bound a local value while CURRENT-BUFFER was active.
2004 If WHERE is nil this means we saw the default value when binding SYMBOL.
2005 WHERE being a buffer or frame means we saw a buffer-local or frame-local
2006 value. Other values of WHERE mean an internal error. */
2007
2008 typedef Lisp_Object (*specbinding_func) (Lisp_Object);
2009
2010 struct specbinding
2011 {
2012 Lisp_Object symbol, old_value;
2013 specbinding_func func;
2014 Lisp_Object unused; /* Dividing by 16 is faster than by 12. */
2015 };
2016
2017 extern struct specbinding *specpdl;
2018 extern struct specbinding *specpdl_ptr;
2019 extern ptrdiff_t specpdl_size;
2020
2021 #define SPECPDL_INDEX() (specpdl_ptr - specpdl)
2022
2023 /* Everything needed to describe an active condition case.
2024
2025 Members are volatile if their values need to survive _longjmp when
2026 a 'struct handler' is a local variable. */
2027 struct handler
2028 {
2029 /* The handler clauses and variable from the condition-case form. */
2030 /* For a handler set up in Lisp code, this is always a list.
2031 For an internal handler set up by internal_condition_case*,
2032 this can instead be the symbol t or `error'.
2033 t: handle all conditions.
2034 error: handle all conditions, and errors can run the debugger
2035 or display a backtrace. */
2036 Lisp_Object handler;
2037
2038 Lisp_Object volatile var;
2039
2040 /* Fsignal stores here the condition-case clause that applies,
2041 and Fcondition_case thus knows which clause to run. */
2042 Lisp_Object volatile chosen_clause;
2043
2044 /* Used to effect the longjump out to the handler. */
2045 struct catchtag *tag;
2046
2047 /* The next enclosing handler. */
2048 struct handler *next;
2049 };
2050
2051 /* This structure helps implement the `catch' and `throw' control
2052 structure. A struct catchtag contains all the information needed
2053 to restore the state of the interpreter after a non-local jump.
2054
2055 Handlers for error conditions (represented by `struct handler'
2056 structures) just point to a catch tag to do the cleanup required
2057 for their jumps.
2058
2059 catchtag structures are chained together in the C calling stack;
2060 the `next' member points to the next outer catchtag.
2061
2062 A call like (throw TAG VAL) searches for a catchtag whose `tag'
2063 member is TAG, and then unbinds to it. The `val' member is used to
2064 hold VAL while the stack is unwound; `val' is returned as the value
2065 of the catch form.
2066
2067 All the other members are concerned with restoring the interpreter
2068 state.
2069
2070 Members are volatile if their values need to survive _longjmp when
2071 a 'struct catchtag' is a local variable. */
2072 struct catchtag
2073 {
2074 Lisp_Object tag;
2075 Lisp_Object volatile val;
2076 struct catchtag *volatile next;
2077 struct gcpro *gcpro;
2078 sys_jmp_buf jmp;
2079 struct backtrace *backlist;
2080 struct handler *handlerlist;
2081 EMACS_INT lisp_eval_depth;
2082 ptrdiff_t volatile pdlcount;
2083 int poll_suppress_count;
2084 int interrupt_input_blocked;
2085 struct byte_stack *byte_stack;
2086 };
2087
2088 extern Lisp_Object memory_signal_data;
2089
2090 /* An address near the bottom of the stack.
2091 Tells GC how to save a copy of the stack. */
2092 extern char *stack_bottom;
2093
2094 /* Check quit-flag and quit if it is non-nil.
2095 Typing C-g does not directly cause a quit; it only sets Vquit_flag.
2096 So the program needs to do QUIT at times when it is safe to quit.
2097 Every loop that might run for a long time or might not exit
2098 ought to do QUIT at least once, at a safe place.
2099 Unless that is impossible, of course.
2100 But it is very desirable to avoid creating loops where QUIT is impossible.
2101
2102 Exception: if you set immediate_quit to nonzero,
2103 then the handler that responds to the C-g does the quit itself.
2104 This is a good thing to do around a loop that has no side effects
2105 and (in particular) cannot call arbitrary Lisp code.
2106
2107 If quit-flag is set to `kill-emacs' the SIGINT handler has received
2108 a request to exit Emacs when it is safe to do. */
2109
2110 extern void process_pending_signals (void);
2111 extern int pending_signals;
2112
2113 extern void process_quit_flag (void);
2114 #define QUIT \
2115 do { \
2116 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
2117 process_quit_flag (); \
2118 else if (pending_signals) \
2119 process_pending_signals (); \
2120 } while (0)
2121
2122
2123 /* Nonzero if ought to quit now. */
2124
2125 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
2126 \f
2127 extern Lisp_Object Vascii_downcase_table;
2128 extern Lisp_Object Vascii_canon_table;
2129 \f
2130 /* Structure for recording stack slots that need marking. */
2131
2132 /* This is a chain of structures, each of which points at a Lisp_Object
2133 variable whose value should be marked in garbage collection.
2134 Normally every link of the chain is an automatic variable of a function,
2135 and its `val' points to some argument or local variable of the function.
2136 On exit to the function, the chain is set back to the value it had on entry.
2137 This way, no link remains in the chain when the stack frame containing the
2138 link disappears.
2139
2140 Every function that can call Feval must protect in this fashion all
2141 Lisp_Object variables whose contents will be used again. */
2142
2143 extern struct gcpro *gcprolist;
2144
2145 struct gcpro
2146 {
2147 struct gcpro *next;
2148
2149 /* Address of first protected variable. */
2150 volatile Lisp_Object *var;
2151
2152 /* Number of consecutive protected variables. */
2153 ptrdiff_t nvars;
2154
2155 #ifdef DEBUG_GCPRO
2156 int level;
2157 #endif
2158 };
2159
2160 /* Values of GC_MARK_STACK during compilation:
2161
2162 0 Use GCPRO as before
2163 1 Do the real thing, make GCPROs and UNGCPRO no-ops.
2164 2 Mark the stack, and check that everything GCPRO'd is
2165 marked.
2166 3 Mark using GCPRO's, mark stack last, and count how many
2167 dead objects are kept alive. */
2168
2169
2170 #define GC_USE_GCPROS_AS_BEFORE 0
2171 #define GC_MAKE_GCPROS_NOOPS 1
2172 #define GC_MARK_STACK_CHECK_GCPROS 2
2173 #define GC_USE_GCPROS_CHECK_ZOMBIES 3
2174
2175 #ifndef GC_MARK_STACK
2176 #define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
2177 #endif
2178
2179 /* Whether we do the stack marking manually. */
2180 #define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
2181 || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
2182
2183
2184 #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
2185
2186 /* Do something silly with gcproN vars just so gcc shuts up. */
2187 /* You get warnings from MIPSPro... */
2188
2189 #define GCPRO1(varname) ((void) gcpro1)
2190 #define GCPRO2(varname1, varname2) ((void) gcpro2, (void) gcpro1)
2191 #define GCPRO3(varname1, varname2, varname3) \
2192 ((void) gcpro3, (void) gcpro2, (void) gcpro1)
2193 #define GCPRO4(varname1, varname2, varname3, varname4) \
2194 ((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
2195 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2196 ((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
2197 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2198 ((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, \
2199 (void) gcpro1)
2200 #define UNGCPRO ((void) 0)
2201
2202 #else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
2203
2204 #ifndef DEBUG_GCPRO
2205
2206 #define GCPRO1(varname) \
2207 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
2208 gcprolist = &gcpro1; }
2209
2210 #define GCPRO2(varname1, varname2) \
2211 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2212 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2213 gcprolist = &gcpro2; }
2214
2215 #define GCPRO3(varname1, varname2, varname3) \
2216 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2217 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2218 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2219 gcprolist = &gcpro3; }
2220
2221 #define GCPRO4(varname1, varname2, varname3, varname4) \
2222 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2223 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2224 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2225 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2226 gcprolist = &gcpro4; }
2227
2228 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2229 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2230 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2231 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2232 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2233 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2234 gcprolist = &gcpro5; }
2235
2236 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2237 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2238 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2239 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2240 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2241 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2242 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
2243 gcprolist = &gcpro6; }
2244
2245 #define UNGCPRO (gcprolist = gcpro1.next)
2246
2247 #else
2248
2249 extern int gcpro_level;
2250
2251 #define GCPRO1(varname) \
2252 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
2253 gcpro1.level = gcpro_level++; \
2254 gcprolist = &gcpro1; }
2255
2256 #define GCPRO2(varname1, varname2) \
2257 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2258 gcpro1.level = gcpro_level; \
2259 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2260 gcpro2.level = gcpro_level++; \
2261 gcprolist = &gcpro2; }
2262
2263 #define GCPRO3(varname1, varname2, varname3) \
2264 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2265 gcpro1.level = gcpro_level; \
2266 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2267 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2268 gcpro3.level = gcpro_level++; \
2269 gcprolist = &gcpro3; }
2270
2271 #define GCPRO4(varname1, varname2, varname3, varname4) \
2272 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2273 gcpro1.level = gcpro_level; \
2274 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2275 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2276 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2277 gcpro4.level = gcpro_level++; \
2278 gcprolist = &gcpro4; }
2279
2280 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
2281 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2282 gcpro1.level = gcpro_level; \
2283 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2284 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2285 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2286 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2287 gcpro5.level = gcpro_level++; \
2288 gcprolist = &gcpro5; }
2289
2290 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
2291 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
2292 gcpro1.level = gcpro_level; \
2293 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
2294 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
2295 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
2296 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
2297 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
2298 gcpro6.level = gcpro_level++; \
2299 gcprolist = &gcpro6; }
2300
2301 #define UNGCPRO \
2302 ((--gcpro_level != gcpro1.level) \
2303 ? (emacs_abort (), 0) \
2304 : ((gcprolist = gcpro1.next), 0))
2305
2306 #endif /* DEBUG_GCPRO */
2307 #endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
2308
2309
2310 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
2311 #define RETURN_UNGCPRO(expr) \
2312 do \
2313 { \
2314 Lisp_Object ret_ungc_val; \
2315 ret_ungc_val = (expr); \
2316 UNGCPRO; \
2317 return ret_ungc_val; \
2318 } \
2319 while (0)
2320
2321 /* Call staticpro (&var) to protect static variable `var'. */
2322
2323 void staticpro (Lisp_Object *);
2324 \f
2325 /* Declare a Lisp-callable function. The MAXARGS parameter has the same
2326 meaning as in the DEFUN macro, and is used to construct a prototype. */
2327 /* We can use the same trick as in the DEFUN macro to generate the
2328 appropriate prototype. */
2329 #define EXFUN(fnname, maxargs) \
2330 extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
2331
2332 /* Forward declarations for prototypes. */
2333 struct window;
2334 struct frame;
2335
2336 /* Simple access functions. */
2337
2338 LISP_INLINE Lisp_Object *
2339 aref_addr (Lisp_Object array, ptrdiff_t idx)
2340 {
2341 return & XVECTOR (array)->contents[idx];
2342 }
2343
2344 LISP_INLINE void
2345 gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
2346 {
2347 /* Like ASET, but also can be used in the garbage collector:
2348 sweep_weak_table calls set_hash_key etc. while the table is marked. */
2349 eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
2350 XVECTOR (array)->contents[idx] = val;
2351 }
2352
2353 /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
2354
2355 LISP_INLINE void
2356 vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
2357 {
2358 eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
2359 memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
2360 }
2361
2362 /* Functions to modify hash tables. */
2363
2364 LISP_INLINE void
2365 set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
2366 {
2367 h->key_and_value = key_and_value;
2368 }
2369
2370 LISP_INLINE void
2371 set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2372 {
2373 gc_aset (h->key_and_value, 2 * idx, val);
2374 }
2375
2376 LISP_INLINE void
2377 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2378 {
2379 gc_aset (h->key_and_value, 2 * idx + 1, val);
2380 }
2381
2382 LISP_INLINE void
2383 set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
2384 {
2385 h->next = next;
2386 }
2387
2388 LISP_INLINE void
2389 set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2390 {
2391 gc_aset (h->next, idx, val);
2392 }
2393
2394 LISP_INLINE void
2395 set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
2396 {
2397 h->hash = hash;
2398 }
2399
2400 LISP_INLINE void
2401 set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2402 {
2403 gc_aset (h->hash, idx, val);
2404 }
2405
2406 LISP_INLINE void
2407 set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
2408 {
2409 h->index = index;
2410 }
2411
2412 LISP_INLINE void
2413 set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
2414 {
2415 gc_aset (h->index, idx, val);
2416 }
2417
2418 /* Use these functions to set Lisp_Object
2419 or pointer slots of struct Lisp_Symbol. */
2420
2421 LISP_INLINE void
2422 set_symbol_name (Lisp_Object sym, Lisp_Object name)
2423 {
2424 XSYMBOL (sym)->name = name;
2425 }
2426
2427 LISP_INLINE void
2428 set_symbol_function (Lisp_Object sym, Lisp_Object function)
2429 {
2430 XSYMBOL (sym)->function = function;
2431 }
2432
2433 LISP_INLINE void
2434 set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
2435 {
2436 XSYMBOL (sym)->plist = plist;
2437 }
2438
2439 LISP_INLINE void
2440 set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
2441 {
2442 XSYMBOL (sym)->next = next;
2443 }
2444
2445 /* Buffer-local (also frame-local) variable access functions. */
2446
2447 LISP_INLINE int
2448 blv_found (struct Lisp_Buffer_Local_Value *blv)
2449 {
2450 eassert (blv->found == !EQ (blv->defcell, blv->valcell));
2451 return blv->found;
2452 }
2453
2454 LISP_INLINE void
2455 set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
2456 {
2457 eassert (found == !EQ (blv->defcell, blv->valcell));
2458 blv->found = found;
2459 }
2460
2461 LISP_INLINE Lisp_Object
2462 blv_value (struct Lisp_Buffer_Local_Value *blv)
2463 {
2464 return XCDR (blv->valcell);
2465 }
2466
2467 LISP_INLINE void
2468 set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2469 {
2470 XSETCDR (blv->valcell, val);
2471 }
2472
2473 LISP_INLINE void
2474 set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2475 {
2476 blv->where = val;
2477 }
2478
2479 LISP_INLINE void
2480 set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2481 {
2482 blv->defcell = val;
2483 }
2484
2485 LISP_INLINE void
2486 set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
2487 {
2488 blv->valcell = val;
2489 }
2490
2491 /* Set overlay's property list. */
2492
2493 LISP_INLINE void
2494 set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
2495 {
2496 XOVERLAY (overlay)->plist = plist;
2497 }
2498
2499 /* Get text properties of S. */
2500
2501 LISP_INLINE INTERVAL
2502 string_intervals (Lisp_Object s)
2503 {
2504 return XSTRING (s)->intervals;
2505 }
2506
2507 /* Set text properties of S to I. */
2508
2509 LISP_INLINE void
2510 set_string_intervals (Lisp_Object s, INTERVAL i)
2511 {
2512 XSTRING (s)->intervals = i;
2513 }
2514
2515 /* Set a Lisp slot in TABLE to VAL. Most code should use this instead
2516 of setting slots directly. */
2517
2518 LISP_INLINE void
2519 set_char_table_ascii (Lisp_Object table, Lisp_Object val)
2520 {
2521 XCHAR_TABLE (table)->ascii = val;
2522 }
2523 LISP_INLINE void
2524 set_char_table_defalt (Lisp_Object table, Lisp_Object val)
2525 {
2526 XCHAR_TABLE (table)->defalt = val;
2527 }
2528 LISP_INLINE void
2529 set_char_table_parent (Lisp_Object table, Lisp_Object val)
2530 {
2531 XCHAR_TABLE (table)->parent = val;
2532 }
2533 LISP_INLINE void
2534 set_char_table_purpose (Lisp_Object table, Lisp_Object val)
2535 {
2536 XCHAR_TABLE (table)->purpose = val;
2537 }
2538
2539 /* Set different slots in (sub)character tables. */
2540
2541 LISP_INLINE void
2542 set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
2543 {
2544 eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
2545 XCHAR_TABLE (table)->extras[idx] = val;
2546 }
2547
2548 LISP_INLINE void
2549 set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
2550 {
2551 eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
2552 XCHAR_TABLE (table)->contents[idx] = val;
2553 }
2554
2555 LISP_INLINE void
2556 set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
2557 {
2558 XSUB_CHAR_TABLE (table)->contents[idx] = val;
2559 }
2560
2561 /* Defined in data.c. */
2562 extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
2563 extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
2564 extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
2565 extern Lisp_Object Qvoid_variable, Qvoid_function;
2566 extern Lisp_Object Qinvalid_read_syntax;
2567 extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
2568 extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
2569 extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
2570 extern Lisp_Object Qtext_read_only;
2571 extern Lisp_Object Qinteractive_form;
2572 extern Lisp_Object Qcircular_list;
2573 extern Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
2574 extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
2575 extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
2576 extern Lisp_Object Qbuffer_or_string_p;
2577 extern Lisp_Object Qfboundp;
2578 extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
2579
2580 extern Lisp_Object Qcdr;
2581
2582 extern Lisp_Object Qrange_error, Qoverflow_error;
2583
2584 extern Lisp_Object Qfloatp;
2585 extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
2586
2587 extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
2588
2589 extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
2590
2591 EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
2592
2593 /* Defined in frame.c. */
2594 extern Lisp_Object Qframep;
2595
2596 /* Defined in data.c. */
2597 extern Lisp_Object indirect_function (Lisp_Object);
2598 extern Lisp_Object find_symbol_value (Lisp_Object);
2599
2600 /* Convert the integer I to an Emacs representation, either the integer
2601 itself, or a cons of two or three integers, or if all else fails a float.
2602 I should not have side effects. */
2603 #define INTEGER_TO_CONS(i) \
2604 (! FIXNUM_OVERFLOW_P (i) \
2605 ? make_number (i) \
2606 : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \
2607 || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \
2608 && FIXNUM_OVERFLOW_P ((i) >> 16)) \
2609 ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
2610 : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \
2611 || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \
2612 && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
2613 ? Fcons (make_number ((i) >> 16 >> 24), \
2614 Fcons (make_number ((i) >> 16 & 0xffffff), \
2615 make_number ((i) & 0xffff))) \
2616 : make_float (i))
2617
2618 /* Convert the Emacs representation CONS back to an integer of type
2619 TYPE, storing the result the variable VAR. Signal an error if CONS
2620 is not a valid representation or is out of range for TYPE. */
2621 #define CONS_TO_INTEGER(cons, type, var) \
2622 (TYPE_SIGNED (type) \
2623 ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \
2624 : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type))))
2625 extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
2626 extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
2627
2628 extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
2629 extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
2630 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
2631 Lisp_Object);
2632 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
2633 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
2634 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
2635 extern void syms_of_data (void);
2636 extern void init_data (void);
2637 extern void swap_in_global_binding (struct Lisp_Symbol *);
2638
2639 /* Defined in cmds.c */
2640 extern void syms_of_cmds (void);
2641 extern void keys_of_cmds (void);
2642
2643 /* Defined in coding.c. */
2644 extern Lisp_Object Qcharset;
2645 extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
2646 ptrdiff_t, bool, bool, Lisp_Object);
2647 extern void init_coding (void);
2648 extern void init_coding_once (void);
2649 extern void syms_of_coding (void);
2650
2651 /* Defined in character.c. */
2652 EXFUN (Fmax_char, 0) ATTRIBUTE_CONST;
2653 extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
2654 extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
2655 extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST;
2656 extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST;
2657 extern void syms_of_character (void);
2658
2659 /* Defined in charset.c. */
2660 extern void init_charset (void);
2661 extern void init_charset_once (void);
2662 extern void syms_of_charset (void);
2663 /* Structure forward declarations. */
2664 struct charset;
2665
2666 /* Defined in composite.c. */
2667 extern void syms_of_composite (void);
2668
2669 /* Defined in syntax.c. */
2670 extern void init_syntax_once (void);
2671 extern void syms_of_syntax (void);
2672
2673 /* Defined in fns.c. */
2674 extern Lisp_Object QCrehash_size, QCrehash_threshold;
2675 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
2676 EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
2677 extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
2678 extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
2679 extern void sweep_weak_hash_tables (void);
2680 extern Lisp_Object Qcursor_in_echo_area;
2681 extern Lisp_Object Qstring_lessp;
2682 extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
2683 EMACS_UINT hash_string (char const *, ptrdiff_t);
2684 EMACS_UINT sxhash (Lisp_Object, int);
2685 Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
2686 Lisp_Object, Lisp_Object, Lisp_Object,
2687 Lisp_Object);
2688 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
2689 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
2690 EMACS_UINT);
2691
2692 extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
2693 ptrdiff_t, ptrdiff_t);
2694 extern Lisp_Object do_yes_or_no_p (Lisp_Object);
2695 extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
2696 extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
2697 extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
2698 extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
2699 extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
2700 extern void clear_string_char_byte_cache (void);
2701 extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
2702 extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
2703 extern Lisp_Object string_to_multibyte (Lisp_Object);
2704 extern Lisp_Object string_make_unibyte (Lisp_Object);
2705 extern void syms_of_fns (void);
2706
2707 /* Defined in floatfns.c. */
2708 extern double extract_float (Lisp_Object);
2709 extern void syms_of_floatfns (void);
2710 extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
2711
2712 /* Defined in fringe.c. */
2713 extern void syms_of_fringe (void);
2714 extern void init_fringe (void);
2715 #ifdef HAVE_WINDOW_SYSTEM
2716 extern void mark_fringe_data (void);
2717 extern void init_fringe_once (void);
2718 #endif /* HAVE_WINDOW_SYSTEM */
2719
2720 /* Defined in image.c. */
2721 extern Lisp_Object QCascent, QCmargin, QCrelief;
2722 extern Lisp_Object QCconversion;
2723 extern int x_bitmap_mask (struct frame *, ptrdiff_t);
2724 extern void syms_of_image (void);
2725
2726 /* Defined in insdel.c. */
2727 extern Lisp_Object Qinhibit_modification_hooks;
2728 extern void move_gap (ptrdiff_t);
2729 extern void move_gap_both (ptrdiff_t, ptrdiff_t);
2730 extern _Noreturn void buffer_overflow (void);
2731 extern void make_gap (ptrdiff_t);
2732 extern ptrdiff_t copy_text (const unsigned char *, unsigned char *,
2733 ptrdiff_t, bool, bool);
2734 extern int count_combining_before (const unsigned char *,
2735 ptrdiff_t, ptrdiff_t, ptrdiff_t);
2736 extern int count_combining_after (const unsigned char *,
2737 ptrdiff_t, ptrdiff_t, ptrdiff_t);
2738 extern void insert (const char *, ptrdiff_t);
2739 extern void insert_and_inherit (const char *, ptrdiff_t);
2740 extern void insert_1 (const char *, ptrdiff_t, bool, bool, bool);
2741 extern void insert_1_both (const char *, ptrdiff_t, ptrdiff_t,
2742 bool, bool, bool);
2743 extern void insert_from_gap (ptrdiff_t, ptrdiff_t);
2744 extern void insert_from_string (Lisp_Object, ptrdiff_t, ptrdiff_t,
2745 ptrdiff_t, ptrdiff_t, bool);
2746 extern void insert_from_buffer (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
2747 extern void insert_char (int);
2748 extern void insert_string (const char *);
2749 extern void insert_before_markers (const char *, ptrdiff_t);
2750 extern void insert_before_markers_and_inherit (const char *, ptrdiff_t);
2751 extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
2752 ptrdiff_t, ptrdiff_t,
2753 ptrdiff_t, bool);
2754 extern void del_range (ptrdiff_t, ptrdiff_t);
2755 extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
2756 extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool);
2757 extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
2758 extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
2759 ptrdiff_t, ptrdiff_t, bool);
2760 extern void modify_region (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
2761 extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
2762 extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
2763 extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
2764 ptrdiff_t, ptrdiff_t);
2765 extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
2766 ptrdiff_t, ptrdiff_t);
2767 extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool);
2768 extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
2769 const char *, ptrdiff_t, ptrdiff_t, bool);
2770 extern void syms_of_insdel (void);
2771
2772 /* Defined in dispnew.c. */
2773 #if (defined PROFILING \
2774 && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
2775 _Noreturn void __executable_start (void);
2776 #endif
2777 extern Lisp_Object selected_frame;
2778 extern Lisp_Object Vwindow_system;
2779 extern Lisp_Object sit_for (Lisp_Object, bool, int);
2780 extern void init_display (void);
2781 extern void syms_of_display (void);
2782
2783 /* Defined in xdisp.c. */
2784 extern Lisp_Object Qinhibit_point_motion_hooks;
2785 extern Lisp_Object Qinhibit_redisplay, Qdisplay;
2786 extern Lisp_Object Qmenu_bar_update_hook;
2787 extern Lisp_Object Qwindow_scroll_functions;
2788 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
2789 extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
2790 extern Lisp_Object Qspace, Qcenter, QCalign_to;
2791 extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
2792 extern Lisp_Object Qleft_margin, Qright_margin;
2793 extern Lisp_Object Qglyphless_char;
2794 extern Lisp_Object QCdata, QCfile;
2795 extern Lisp_Object QCmap;
2796 extern Lisp_Object Qrisky_local_variable;
2797 extern struct frame *last_glyphless_glyph_frame;
2798 extern int last_glyphless_glyph_face_id;
2799 extern int last_glyphless_glyph_merged_face_id;
2800 extern int noninteractive_need_newline;
2801 extern Lisp_Object echo_area_buffer[2];
2802 extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
2803 extern void check_message_stack (void);
2804 extern void setup_echo_area_for_printing (int);
2805 extern bool push_message (void);
2806 extern Lisp_Object pop_message_unwind (Lisp_Object);
2807 extern Lisp_Object restore_message_unwind (Lisp_Object);
2808 extern void restore_message (void);
2809 extern Lisp_Object current_message (void);
2810 extern void clear_message (int, int);
2811 extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
2812 extern void message1 (const char *);
2813 extern void message1_nolog (const char *);
2814 extern void message2 (const char *, ptrdiff_t, int);
2815 extern void message2_nolog (const char *, ptrdiff_t, int);
2816 extern void message3 (Lisp_Object, ptrdiff_t, int);
2817 extern void message3_nolog (Lisp_Object, ptrdiff_t, int);
2818 extern void message_dolog (const char *, ptrdiff_t, int, int);
2819 extern void message_with_string (const char *, Lisp_Object, int);
2820 extern void message_log_maybe_newline (void);
2821 extern void update_echo_area (void);
2822 extern void truncate_echo_area (ptrdiff_t);
2823 extern void redisplay (void);
2824 extern void redisplay_preserve_echo_area (int);
2825 extern void prepare_menu_bars (void);
2826
2827 void set_frame_cursor_types (struct frame *, Lisp_Object);
2828 extern void syms_of_xdisp (void);
2829 extern void init_xdisp (void);
2830 extern Lisp_Object safe_eval (Lisp_Object);
2831 extern int pos_visible_p (struct window *, ptrdiff_t, int *,
2832 int *, int *, int *, int *, int *);
2833
2834 /* Defined in xsettings.c. */
2835 extern void syms_of_xsettings (void);
2836
2837 /* Defined in vm-limit.c. */
2838 extern void memory_warnings (void *, void (*warnfun) (const char *));
2839
2840 /* Defined in alloc.c. */
2841 extern void check_pure_size (void);
2842 extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
2843 extern void malloc_warning (const char *);
2844 extern _Noreturn void memory_full (size_t);
2845 extern _Noreturn void buffer_memory_full (ptrdiff_t);
2846 extern bool survives_gc_p (Lisp_Object);
2847 extern void mark_object (Lisp_Object);
2848 #if defined REL_ALLOC && !defined SYSTEM_MALLOC
2849 extern void refill_memory_reserve (void);
2850 #endif
2851 extern const char *pending_malloc_warning;
2852 extern Lisp_Object zero_vector;
2853 extern Lisp_Object *stack_base;
2854 extern EMACS_INT consing_since_gc;
2855 extern EMACS_INT gc_relative_threshold;
2856 extern EMACS_INT memory_full_cons_threshold;
2857 extern Lisp_Object list1 (Lisp_Object);
2858 extern Lisp_Object list2 (Lisp_Object, Lisp_Object);
2859 extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
2860 extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
2861 extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
2862 Lisp_Object);
2863 enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
2864 extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
2865 extern _Noreturn void string_overflow (void);
2866 extern Lisp_Object make_string (const char *, ptrdiff_t);
2867 extern Lisp_Object make_formatted_string (char *, const char *, ...)
2868 ATTRIBUTE_FORMAT_PRINTF (2, 3);
2869 extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
2870
2871 /* Make unibyte string from C string when the length isn't known. */
2872
2873 LISP_INLINE Lisp_Object
2874 build_unibyte_string (const char *str)
2875 {
2876 return make_unibyte_string (str, strlen (str));
2877 }
2878
2879 extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
2880 extern Lisp_Object make_event_array (int, Lisp_Object *);
2881 extern Lisp_Object make_uninit_string (EMACS_INT);
2882 extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
2883 extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
2884 extern Lisp_Object make_specified_string (const char *,
2885 ptrdiff_t, ptrdiff_t, bool);
2886 extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
2887 extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
2888
2889 /* Make a string allocated in pure space, use STR as string data. */
2890
2891 LISP_INLINE Lisp_Object
2892 build_pure_c_string (const char *str)
2893 {
2894 return make_pure_c_string (str, strlen (str));
2895 }
2896
2897 /* Make a string from the data at STR, treating it as multibyte if the
2898 data warrants. */
2899
2900 LISP_INLINE Lisp_Object
2901 build_string (const char *str)
2902 {
2903 return make_string (str, strlen (str));
2904 }
2905
2906 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
2907 extern void make_byte_code (struct Lisp_Vector *);
2908 extern Lisp_Object Qchar_table_extra_slots;
2909 extern struct Lisp_Vector *allocate_vector (EMACS_INT);
2910 extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
2911 #define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
2912 ((typ*) \
2913 allocate_pseudovector \
2914 (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag))
2915 extern struct Lisp_Hash_Table *allocate_hash_table (void);
2916 extern struct window *allocate_window (void);
2917 extern struct frame *allocate_frame (void);
2918 extern struct Lisp_Process *allocate_process (void);
2919 extern struct terminal *allocate_terminal (void);
2920 extern bool gc_in_progress;
2921 extern bool abort_on_gc;
2922 extern Lisp_Object make_float (double);
2923 extern void display_malloc_warning (void);
2924 extern ptrdiff_t inhibit_garbage_collection (void);
2925 extern Lisp_Object make_save_value (void *, ptrdiff_t);
2926 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
2927 extern void free_marker (Lisp_Object);
2928 extern void free_cons (struct Lisp_Cons *);
2929 extern void init_alloc_once (void);
2930 extern void init_alloc (void);
2931 extern void syms_of_alloc (void);
2932 extern struct buffer * allocate_buffer (void);
2933 extern int valid_lisp_object_p (Lisp_Object);
2934 #ifdef GC_CHECK_CONS_LIST
2935 extern void check_cons_list (void);
2936 #else
2937 #define check_cons_list() ((void) 0)
2938 #endif
2939
2940 #ifdef REL_ALLOC
2941 /* Defined in ralloc.c. */
2942 extern void *r_alloc (void **, size_t);
2943 extern void r_alloc_free (void **);
2944 extern void *r_re_alloc (void **, size_t);
2945 extern void r_alloc_reset_variable (void **, void **);
2946 extern void r_alloc_inhibit_buffer_relocation (int);
2947 #endif
2948
2949 /* Defined in chartab.c. */
2950 extern Lisp_Object copy_char_table (Lisp_Object);
2951 extern Lisp_Object char_table_ref (Lisp_Object, int);
2952 extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
2953 int *, int *);
2954 extern void char_table_set (Lisp_Object, int, Lisp_Object);
2955 extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
2956 extern int char_table_translate (Lisp_Object, int);
2957 extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
2958 Lisp_Object),
2959 Lisp_Object, Lisp_Object, Lisp_Object);
2960 extern void map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
2961 Lisp_Object, Lisp_Object,
2962 Lisp_Object, struct charset *,
2963 unsigned, unsigned);
2964 extern Lisp_Object uniprop_table (Lisp_Object);
2965 extern void syms_of_chartab (void);
2966
2967 /* Defined in print.c. */
2968 extern Lisp_Object Vprin1_to_string_buffer;
2969 extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
2970 extern Lisp_Object Qstandard_output;
2971 extern Lisp_Object Qexternal_debugging_output;
2972 extern void temp_output_buffer_setup (const char *);
2973 extern int print_level;
2974 extern Lisp_Object Qprint_escape_newlines;
2975 extern void write_string (const char *, int);
2976 extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
2977 Lisp_Object);
2978 extern Lisp_Object internal_with_output_to_temp_buffer
2979 (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
2980 enum FLOAT_TO_STRING_BUFSIZE { FLOAT_TO_STRING_BUFSIZE = 350 };
2981 extern int float_to_string (char *, double);
2982 extern void syms_of_print (void);
2983
2984 /* Defined in doprnt.c. */
2985 extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
2986 va_list);
2987 extern ptrdiff_t esprintf (char *, char const *, ...)
2988 ATTRIBUTE_FORMAT_PRINTF (2, 3);
2989 extern ptrdiff_t exprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
2990 char const *, ...)
2991 ATTRIBUTE_FORMAT_PRINTF (5, 6);
2992 extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
2993 char const *, va_list)
2994 ATTRIBUTE_FORMAT_PRINTF (5, 0);
2995
2996 /* Defined in lread.c. */
2997 extern Lisp_Object Qvariable_documentation, Qstandard_input;
2998 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
2999 extern Lisp_Object Qlexical_binding;
3000 extern Lisp_Object check_obarray (Lisp_Object);
3001 extern Lisp_Object intern_1 (const char *, ptrdiff_t);
3002 extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
3003 extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
3004 #define LOADHIST_ATTACH(x) \
3005 do { \
3006 if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \
3007 } while (0)
3008 extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
3009 Lisp_Object *, Lisp_Object);
3010 Lisp_Object string_to_number (char const *, int, int);
3011 extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
3012 Lisp_Object);
3013 extern void dir_warning (const char *, Lisp_Object);
3014 extern void close_load_descs (void);
3015 extern void init_obarray (void);
3016 extern void init_lread (void);
3017 extern void syms_of_lread (void);
3018
3019 LISP_INLINE Lisp_Object
3020 intern (const char *str)
3021 {
3022 return intern_1 (str, strlen (str));
3023 }
3024
3025 LISP_INLINE Lisp_Object
3026 intern_c_string (const char *str)
3027 {
3028 return intern_c_string_1 (str, strlen (str));
3029 }
3030
3031 /* Defined in eval.c. */
3032 extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
3033 extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
3034 extern Lisp_Object Qand_rest;
3035 extern Lisp_Object Vautoload_queue;
3036 extern Lisp_Object Vsignaling_function;
3037 extern Lisp_Object inhibit_lisp_code;
3038 #if BYTE_MARK_STACK
3039 extern struct catchtag *catchlist;
3040 extern struct handler *handlerlist;
3041 #endif
3042 /* To run a normal hook, use the appropriate function from the list below.
3043 The calling convention:
3044
3045 if (!NILP (Vrun_hooks))
3046 call1 (Vrun_hooks, Qmy_funny_hook);
3047
3048 should no longer be used. */
3049 extern Lisp_Object Vrun_hooks;
3050 extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
3051 extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
3052 Lisp_Object (*funcall)
3053 (ptrdiff_t nargs, Lisp_Object *args));
3054 extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
3055 extern _Noreturn void xsignal0 (Lisp_Object);
3056 extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
3057 extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
3058 extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
3059 Lisp_Object);
3060 extern _Noreturn void signal_error (const char *, Lisp_Object);
3061 extern Lisp_Object eval_sub (Lisp_Object form);
3062 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
3063 extern Lisp_Object call0 (Lisp_Object);
3064 extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
3065 extern Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object);
3066 extern Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3067 extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3068 extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3069 extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3070 extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3071 extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
3072 extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
3073 extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
3074 extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
3075 extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
3076 extern Lisp_Object internal_condition_case_n
3077 (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
3078 Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
3079 extern void specbind (Lisp_Object, Lisp_Object);
3080 extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
3081 extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
3082 extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
3083 extern _Noreturn void verror (const char *, va_list)
3084 ATTRIBUTE_FORMAT_PRINTF (1, 0);
3085 extern Lisp_Object un_autoload (Lisp_Object);
3086 extern Lisp_Object call_debugger (Lisp_Object arg);
3087 extern void init_eval_once (void);
3088 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
3089 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
3090 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
3091 extern void init_eval (void);
3092 #if BYTE_MARK_STACK
3093 extern void mark_backtrace (void);
3094 #endif
3095 extern void syms_of_eval (void);
3096
3097 /* Defined in editfns.c. */
3098 extern Lisp_Object Qfield;
3099 extern void insert1 (Lisp_Object);
3100 extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
3101 extern Lisp_Object save_excursion_save (void);
3102 extern Lisp_Object save_restriction_save (void);
3103 extern Lisp_Object save_excursion_restore (Lisp_Object);
3104 extern Lisp_Object save_restriction_restore (Lisp_Object);
3105 extern _Noreturn void time_overflow (void);
3106 extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
3107 extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3108 ptrdiff_t, bool);
3109 extern void init_editfns (void);
3110 const char *get_system_name (void);
3111 extern void syms_of_editfns (void);
3112 extern void set_time_zone_rule (const char *);
3113
3114 /* Defined in buffer.c. */
3115 extern bool mouse_face_overlay_overlaps (Lisp_Object);
3116 extern _Noreturn void nsberror (Lisp_Object);
3117 extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
3118 extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
3119 extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
3120 extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
3121 Lisp_Object, Lisp_Object, Lisp_Object);
3122 extern bool overlay_touches_p (ptrdiff_t);
3123 extern Lisp_Object Vbuffer_alist;
3124 extern Lisp_Object set_buffer_if_live (Lisp_Object);
3125 extern Lisp_Object other_buffer_safely (Lisp_Object);
3126 extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
3127 extern Lisp_Object get_truename_buffer (Lisp_Object);
3128 extern void init_buffer_once (void);
3129 extern void init_buffer (void);
3130 extern void syms_of_buffer (void);
3131 extern void keys_of_buffer (void);
3132
3133 /* Defined in marker.c. */
3134
3135 extern ptrdiff_t marker_position (Lisp_Object);
3136 extern ptrdiff_t marker_byte_position (Lisp_Object);
3137 extern void clear_charpos_cache (struct buffer *);
3138 extern ptrdiff_t charpos_to_bytepos (ptrdiff_t);
3139 extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
3140 extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
3141 extern void unchain_marker (struct Lisp_Marker *marker);
3142 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
3143 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
3144 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
3145 ptrdiff_t, ptrdiff_t);
3146 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
3147 extern void syms_of_marker (void);
3148
3149 /* Defined in fileio.c. */
3150
3151 extern Lisp_Object Qfile_error;
3152 extern Lisp_Object Qfile_exists_p;
3153 extern Lisp_Object Qfile_directory_p;
3154 extern Lisp_Object Qinsert_file_contents;
3155 extern Lisp_Object Qfile_name_history;
3156 extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
3157 EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
3158 extern Lisp_Object close_file_unwind (Lisp_Object);
3159 extern Lisp_Object restore_point_unwind (Lisp_Object);
3160 extern _Noreturn void report_file_error (const char *, Lisp_Object);
3161 extern void internal_delete_file (Lisp_Object);
3162 extern void syms_of_fileio (void);
3163 extern Lisp_Object make_temp_name (Lisp_Object, bool);
3164 extern Lisp_Object Qdelete_file;
3165
3166 /* Defined in search.c. */
3167 extern void shrink_regexp_cache (void);
3168 extern void restore_search_regs (void);
3169 extern void record_unwind_save_match_data (void);
3170 struct re_registers;
3171 extern struct re_pattern_buffer *compile_pattern (Lisp_Object,
3172 struct re_registers *,
3173 Lisp_Object, int, int);
3174 extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object);
3175 extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *,
3176 ptrdiff_t);
3177 extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
3178 extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t,
3179 ptrdiff_t, ptrdiff_t, Lisp_Object);
3180 extern ptrdiff_t scan_buffer (int, ptrdiff_t, ptrdiff_t, ptrdiff_t,
3181 ptrdiff_t *, int);
3182 extern EMACS_INT scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
3183 EMACS_INT, int);
3184 extern ptrdiff_t find_next_newline (ptrdiff_t, int);
3185 extern ptrdiff_t find_next_newline_no_quit (ptrdiff_t, ptrdiff_t);
3186 extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t);
3187 extern void syms_of_search (void);
3188 extern void clear_regexp_cache (void);
3189
3190 /* Defined in minibuf.c. */
3191
3192 extern Lisp_Object Qcompletion_ignore_case;
3193 extern Lisp_Object Vminibuffer_list;
3194 extern Lisp_Object last_minibuf_string;
3195 extern Lisp_Object get_minibuffer (EMACS_INT);
3196 extern void init_minibuf_once (void);
3197 extern void syms_of_minibuf (void);
3198
3199 /* Defined in callint.c. */
3200
3201 extern Lisp_Object Qminus, Qplus;
3202 extern Lisp_Object Qwhen;
3203 extern Lisp_Object Qcall_interactively, Qmouse_leave_buffer_hook;
3204 extern void syms_of_callint (void);
3205
3206 /* Defined in casefiddle.c. */
3207
3208 extern Lisp_Object Qidentity;
3209 extern void syms_of_casefiddle (void);
3210 extern void keys_of_casefiddle (void);
3211
3212 /* Defined in casetab.c. */
3213
3214 extern void init_casetab_once (void);
3215 extern void syms_of_casetab (void);
3216
3217 /* Defined in keyboard.c. */
3218
3219 extern Lisp_Object echo_message_buffer;
3220 extern struct kboard *echo_kboard;
3221 extern void cancel_echoing (void);
3222 extern Lisp_Object Qdisabled, QCfilter;
3223 extern Lisp_Object Qup, Qdown, Qbottom;
3224 extern Lisp_Object Qtop;
3225 extern Lisp_Object last_undo_boundary;
3226 extern int input_pending;
3227 extern Lisp_Object menu_bar_items (Lisp_Object);
3228 extern Lisp_Object tool_bar_items (Lisp_Object, int *);
3229 extern void discard_mouse_events (void);
3230 extern Lisp_Object pending_funcalls;
3231 extern int detect_input_pending (void);
3232 extern int detect_input_pending_ignore_squeezables (void);
3233 extern int detect_input_pending_run_timers (int);
3234 extern void safe_run_hooks (Lisp_Object);
3235 extern void cmd_error_internal (Lisp_Object, const char *);
3236 extern Lisp_Object command_loop_1 (void);
3237 extern Lisp_Object recursive_edit_1 (void);
3238 extern void record_auto_save (void);
3239 extern void force_auto_save_soon (void);
3240 extern void init_keyboard (void);
3241 extern void syms_of_keyboard (void);
3242 extern void keys_of_keyboard (void);
3243
3244 /* Defined in indent.c. */
3245 extern ptrdiff_t current_column (void);
3246 extern void invalidate_current_column (void);
3247 extern int indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT);
3248 extern void syms_of_indent (void);
3249
3250 /* Defined in frame.c. */
3251 extern Lisp_Object Qonly, Qnone;
3252 extern Lisp_Object Qvisible;
3253 extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
3254 extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
3255 extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
3256 #if HAVE_NS
3257 extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
3258 #endif
3259 extern Lisp_Object frame_buffer_predicate (Lisp_Object);
3260 extern void frames_discard_buffer (Lisp_Object);
3261 extern void syms_of_frame (void);
3262
3263 /* Defined in emacs.c. */
3264 extern char **initial_argv;
3265 extern int initial_argc;
3266 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
3267 extern bool display_arg;
3268 #endif
3269 extern Lisp_Object decode_env_path (const char *, const char *);
3270 extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
3271 extern Lisp_Object Qfile_name_handler_alist;
3272 extern _Noreturn void fatal_error_backtrace (int, int);
3273 extern Lisp_Object Qkill_emacs;
3274 #if HAVE_SETLOCALE
3275 void fixup_locale (void);
3276 void synchronize_system_messages_locale (void);
3277 void synchronize_system_time_locale (void);
3278 #else
3279 #define setlocale(category, locale)
3280 #define fixup_locale()
3281 #define synchronize_system_messages_locale()
3282 #define synchronize_system_time_locale()
3283 #endif
3284 extern void shut_down_emacs (int, Lisp_Object);
3285
3286 /* True means don't do interactive redisplay and don't change tty modes. */
3287 extern bool noninteractive;
3288
3289 /* True means remove site-lisp directories from load-path. */
3290 extern bool no_site_lisp;
3291
3292 /* Pipe used to send exit notification to the daemon parent at
3293 startup. */
3294 extern int daemon_pipe[2];
3295 #define IS_DAEMON (daemon_pipe[1] != 0)
3296
3297 /* True if handling a fatal error already. */
3298 extern bool fatal_error_in_progress;
3299
3300 /* True means don't do use window-system-specific display code. */
3301 extern bool inhibit_window_system;
3302 /* True means that a filter or a sentinel is running. */
3303 extern bool running_asynch_code;
3304
3305 /* Defined in process.c. */
3306 extern Lisp_Object QCtype, Qlocal;
3307 extern Lisp_Object Qprocessp;
3308 extern void kill_buffer_processes (Lisp_Object);
3309 extern int wait_reading_process_output (intmax_t, int, int, int,
3310 Lisp_Object,
3311 struct Lisp_Process *,
3312 int);
3313 /* Max value for the first argument of wait_reading_process_output. */
3314 #if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5)
3315 /* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3.
3316 The bug merely causes a bogus warning, but the warning is annoying. */
3317 # define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
3318 #else
3319 # define WAIT_READING_MAX INTMAX_MAX
3320 #endif
3321 extern void add_keyboard_wait_descriptor (int);
3322 extern void delete_keyboard_wait_descriptor (int);
3323 #ifdef HAVE_GPM
3324 extern void add_gpm_wait_descriptor (int);
3325 extern void delete_gpm_wait_descriptor (int);
3326 #endif
3327 extern void close_process_descs (void);
3328 extern void init_process_emacs (void);
3329 extern void syms_of_process (void);
3330 extern void setup_process_coding_systems (Lisp_Object);
3331
3332 #ifndef DOS_NT
3333 _Noreturn
3334 #endif
3335 extern int child_setup (int, int, int, char **, bool, Lisp_Object);
3336 extern void init_callproc_1 (void);
3337 extern void init_callproc (void);
3338 extern void set_initial_environment (void);
3339 extern void syms_of_callproc (void);
3340
3341 /* Defined in doc.c. */
3342 extern Lisp_Object Qfunction_documentation;
3343 extern Lisp_Object read_doc_string (Lisp_Object);
3344 extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
3345 extern void syms_of_doc (void);
3346 extern int read_bytecode_char (bool);
3347
3348 /* Defined in bytecode.c. */
3349 extern Lisp_Object Qbytecode;
3350 extern void syms_of_bytecode (void);
3351 extern struct byte_stack *byte_stack_list;
3352 #if BYTE_MARK_STACK
3353 extern void mark_byte_stack (void);
3354 #endif
3355 extern void unmark_byte_stack (void);
3356 extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
3357 Lisp_Object, ptrdiff_t, Lisp_Object *);
3358
3359 /* Defined in macros.c. */
3360 extern Lisp_Object Qexecute_kbd_macro;
3361 extern void init_macros (void);
3362 extern void syms_of_macros (void);
3363
3364 /* Defined in undo.c. */
3365 extern Lisp_Object Qapply;
3366 extern Lisp_Object Qinhibit_read_only;
3367 extern void truncate_undo_list (struct buffer *);
3368 extern void record_marker_adjustment (Lisp_Object, ptrdiff_t);
3369 extern void record_insert (ptrdiff_t, ptrdiff_t);
3370 extern void record_delete (ptrdiff_t, Lisp_Object);
3371 extern void record_first_change (void);
3372 extern void record_change (ptrdiff_t, ptrdiff_t);
3373 extern void record_property_change (ptrdiff_t, ptrdiff_t,
3374 Lisp_Object, Lisp_Object,
3375 Lisp_Object);
3376 extern void syms_of_undo (void);
3377 /* Defined in textprop.c. */
3378 extern Lisp_Object Qfont, Qmouse_face;
3379 extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
3380 extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
3381 extern Lisp_Object Qminibuffer_prompt;
3382
3383 extern void report_interval_modification (Lisp_Object, Lisp_Object);
3384
3385 /* Defined in menu.c. */
3386 extern void syms_of_menu (void);
3387
3388 /* Defined in xmenu.c. */
3389 extern void syms_of_xmenu (void);
3390
3391 /* Defined in termchar.h. */
3392 struct tty_display_info;
3393
3394 /* Defined in termhooks.h. */
3395 struct terminal;
3396
3397 /* Defined in sysdep.c. */
3398 #ifndef HAVE_GET_CURRENT_DIR_NAME
3399 extern char *get_current_dir_name (void);
3400 #endif
3401 extern void stuff_char (char c);
3402 extern void init_sigio (int);
3403 extern void sys_subshell (void);
3404 extern void sys_suspend (void);
3405 extern void discard_tty_input (void);
3406 extern void init_sys_modes (struct tty_display_info *);
3407 extern void reset_sys_modes (struct tty_display_info *);
3408 extern void init_all_sys_modes (void);
3409 extern void reset_all_sys_modes (void);
3410 extern void wait_for_termination (pid_t);
3411 extern void interruptible_wait_for_termination (pid_t);
3412 extern void flush_pending_output (int) ATTRIBUTE_CONST;
3413 extern void child_setup_tty (int);
3414 extern void setup_pty (int);
3415 extern int set_window_size (int, int, int);
3416 extern EMACS_INT get_random (void);
3417 extern void seed_random (void *, ptrdiff_t);
3418 extern void init_random (void);
3419 extern void emacs_backtrace (int);
3420 extern _Noreturn void emacs_abort (void) NO_INLINE;
3421 extern int emacs_open (const char *, int, int);
3422 extern int emacs_close (int);
3423 extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
3424 extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
3425 enum { READLINK_BUFSIZE = 1024 };
3426 extern char *emacs_readlink (const char *, char [READLINK_BUFSIZE]);
3427
3428 extern void unlock_all_files (void);
3429 extern void lock_file (Lisp_Object);
3430 extern void unlock_file (Lisp_Object);
3431 extern void unlock_buffer (struct buffer *);
3432 extern void syms_of_filelock (void);
3433
3434 /* Defined in sound.c. */
3435 extern void syms_of_sound (void);
3436
3437 /* Defined in category.c. */
3438 extern void init_category_once (void);
3439 extern Lisp_Object char_category_set (int);
3440 extern void syms_of_category (void);
3441
3442 /* Defined in ccl.c. */
3443 extern void syms_of_ccl (void);
3444
3445 /* Defined in dired.c. */
3446 extern void syms_of_dired (void);
3447 extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
3448 Lisp_Object, Lisp_Object,
3449 bool, Lisp_Object);
3450
3451 /* Defined in term.c. */
3452 extern int *char_ins_del_vector;
3453 extern void syms_of_term (void);
3454 extern _Noreturn void fatal (const char *msgid, ...)
3455 ATTRIBUTE_FORMAT_PRINTF (1, 2);
3456
3457 /* Defined in terminal.c. */
3458 extern void syms_of_terminal (void);
3459
3460 /* Defined in font.c. */
3461 extern void syms_of_font (void);
3462 extern void init_font (void);
3463
3464 #ifdef HAVE_WINDOW_SYSTEM
3465 /* Defined in fontset.c. */
3466 extern void syms_of_fontset (void);
3467
3468 /* Defined in xfns.c, w32fns.c, or macfns.c. */
3469 extern Lisp_Object Qfont_param;
3470 #endif
3471
3472 /* Defined in xfaces.c. */
3473 extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
3474 extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
3475 extern Lisp_Object Qmode_line_inactive;
3476 extern Lisp_Object Qface;
3477 extern Lisp_Object Qnormal;
3478 extern Lisp_Object QCfamily, QCweight, QCslant;
3479 extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
3480 extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
3481 extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
3482 extern Lisp_Object Qoblique, Qitalic;
3483 extern Lisp_Object Vface_alternative_font_family_alist;
3484 extern Lisp_Object Vface_alternative_font_registry_alist;
3485 extern void syms_of_xfaces (void);
3486
3487 #ifdef HAVE_X_WINDOWS
3488 /* Defined in xfns.c. */
3489 extern void syms_of_xfns (void);
3490
3491 /* Defined in xsmfns.c. */
3492 extern void syms_of_xsmfns (void);
3493
3494 /* Defined in xselect.c. */
3495 extern void syms_of_xselect (void);
3496
3497 /* Defined in xterm.c. */
3498 extern void syms_of_xterm (void);
3499 #endif /* HAVE_X_WINDOWS */
3500
3501 #ifdef HAVE_WINDOW_SYSTEM
3502 /* Defined in xterm.c, nsterm.m, w32term.c. */
3503 extern char *x_get_keysym_name (int);
3504 #endif /* HAVE_WINDOW_SYSTEM */
3505
3506 #ifdef HAVE_LIBXML2
3507 /* Defined in xml.c. */
3508 extern void syms_of_xml (void);
3509 extern void xml_cleanup_parser (void);
3510 #endif
3511
3512 #ifdef HAVE_MENUS
3513 /* Defined in (x|w32)fns.c, nsfns.m... */
3514 extern int have_menus_p (void);
3515 #endif
3516
3517 #ifdef HAVE_DBUS
3518 /* Defined in dbusbind.c. */
3519 void syms_of_dbusbind (void);
3520 #endif
3521
3522 #ifdef DOS_NT
3523 /* Defined in msdos.c, w32.c. */
3524 extern char *emacs_root_dir (void);
3525 #endif /* DOS_NT */
3526 \f
3527 /* True means Emacs has already been initialized.
3528 Used during startup to detect startup of dumped Emacs. */
3529 extern bool initialized;
3530
3531 extern int immediate_quit; /* Nonzero means ^G can quit instantly. */
3532
3533 extern void *xmalloc (size_t);
3534 extern void *xzalloc (size_t);
3535 extern void *xrealloc (void *, size_t);
3536 extern void xfree (void *);
3537 extern void *xnmalloc (ptrdiff_t, ptrdiff_t);
3538 extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t);
3539 extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
3540
3541 extern char *xstrdup (const char *);
3542
3543 extern char *egetenv (const char *);
3544
3545 /* Set up the name of the machine we're running on. */
3546 extern void init_system_name (void);
3547
3548 /* We used to use `abs', but that clashes with system headers on some
3549 platforms, and using a name reserved by Standard C is a bad idea
3550 anyway. */
3551 #if !defined (eabs)
3552 #define eabs(x) ((x) < 0 ? -(x) : (x))
3553 #endif
3554
3555 /* Return a fixnum or float, depending on whether VAL fits in a Lisp
3556 fixnum. */
3557
3558 #define make_fixnum_or_float(val) \
3559 (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))
3560
3561 /* SAFE_ALLOCA normally allocates memory on the stack, but if size is
3562 larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
3563
3564 enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
3565
3566 extern Lisp_Object safe_alloca_unwind (Lisp_Object);
3567 extern void *record_xmalloc (size_t);
3568
3569 #define USE_SAFE_ALLOCA \
3570 ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = 0
3571
3572 /* SAFE_ALLOCA allocates a simple buffer. */
3573
3574 #define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
3575 ? alloca (size) \
3576 : (sa_must_free = 1, record_xmalloc (size)))
3577
3578 /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
3579 NITEMS items, each of the same type as *BUF. MULTIPLIER must
3580 positive. The code is tuned for MULTIPLIER being a constant. */
3581
3582 #define SAFE_NALLOCA(buf, multiplier, nitems) \
3583 do { \
3584 if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \
3585 (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \
3586 else \
3587 { \
3588 (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
3589 sa_must_free = 1; \
3590 record_unwind_protect (safe_alloca_unwind, \
3591 make_save_value (buf, 0)); \
3592 } \
3593 } while (0)
3594
3595 /* SAFE_FREE frees xmalloced memory and enables GC as needed. */
3596
3597 #define SAFE_FREE() \
3598 do { \
3599 if (sa_must_free) { \
3600 sa_must_free = 0; \
3601 unbind_to (sa_count, Qnil); \
3602 } \
3603 } while (0)
3604
3605
3606 /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
3607
3608 #define SAFE_ALLOCA_LISP(buf, nelt) \
3609 do { \
3610 if ((nelt) < MAX_ALLOCA / word_size) \
3611 buf = alloca ((nelt) * word_size); \
3612 else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
3613 { \
3614 Lisp_Object arg_; \
3615 buf = xmalloc ((nelt) * word_size); \
3616 arg_ = make_save_value (buf, nelt); \
3617 XSAVE_VALUE (arg_)->dogc = 1; \
3618 sa_must_free = 1; \
3619 record_unwind_protect (safe_alloca_unwind, arg_); \
3620 } \
3621 else \
3622 memory_full (SIZE_MAX); \
3623 } while (0)
3624
3625
3626 #include "globals.h"
3627
3628 /* Check whether it's time for GC, and run it if so. */
3629
3630 LISP_INLINE void
3631 maybe_gc (void)
3632 {
3633 if ((consing_since_gc > gc_cons_threshold
3634 && consing_since_gc > gc_relative_threshold)
3635 || (!NILP (Vmemory_full)
3636 && consing_since_gc > memory_full_cons_threshold))
3637 Fgarbage_collect ();
3638 }
3639
3640 LISP_INLINE int
3641 functionp (Lisp_Object object)
3642 {
3643 if (SYMBOLP (object) && !NILP (Ffboundp (object)))
3644 {
3645 object = Findirect_function (object, Qt);
3646
3647 if (CONSP (object) && EQ (XCAR (object), Qautoload))
3648 {
3649 /* Autoloaded symbols are functions, except if they load
3650 macros or keymaps. */
3651 int i;
3652 for (i = 0; i < 4 && CONSP (object); i++)
3653 object = XCDR (object);
3654
3655 return ! (CONSP (object) && !NILP (XCAR (object)));
3656 }
3657 }
3658
3659 if (SUBRP (object))
3660 return XSUBR (object)->max_args != UNEVALLED;
3661 else if (COMPILEDP (object))
3662 return 1;
3663 else if (CONSP (object))
3664 {
3665 Lisp_Object car = XCAR (object);
3666 return EQ (car, Qlambda) || EQ (car, Qclosure);
3667 }
3668 else
3669 return 0;
3670 }
3671
3672 INLINE_HEADER_END
3673
3674 #endif /* EMACS_LISP_H */