2f9a30fdfe95b7a55f97b3e01d8279238fb89755
[bpt/emacs.git] / src / lisp.h
1 /* Fundamental definitions for GNU Emacs Lisp interpreter.
2
3 Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation,
4 Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #ifndef EMACS_LISP_H
22 #define EMACS_LISP_H
23
24 #include <setjmp.h>
25 #include <stdalign.h>
26 #include <stdarg.h>
27 #include <stddef.h>
28 #include <float.h>
29 #include <inttypes.h>
30 #include <limits.h>
31
32 #include <intprops.h>
33 #include <verify.h>
34
35 INLINE_HEADER_BEGIN
36
37 /* Define a TYPE constant ID as an externally visible name. Use like this:
38
39 DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
40 #define ID something
41 DEFINE_GDB_SYMBOL_END (ID)
42
43 This hack is for the benefit of compilers that do not make macro
44 definitions visible to the debugger. It's used for symbols that
45 .gdbinit needs, symbols whose values may not fit in 'int' (where an
46 enum would suffice). */
47 #if defined MAIN_PROGRAM
48 # define DEFINE_GDB_SYMBOL_BEGIN(type, id) type const id EXTERNALLY_VISIBLE
49 # define DEFINE_GDB_SYMBOL_END(id) = id;
50 #else
51 # define DEFINE_GDB_SYMBOL_BEGIN(type, id)
52 # define DEFINE_GDB_SYMBOL_END(val)
53 #endif
54
55 /* The ubiquitous max and min macros. */
56 #undef min
57 #undef max
58 #define max(a, b) ((a) > (b) ? (a) : (b))
59 #define min(a, b) ((a) < (b) ? (a) : (b))
60
61 /* EMACS_INT - signed integer wide enough to hold an Emacs value
62 EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
63 pI - printf length modifier for EMACS_INT
64 EMACS_UINT - unsigned variant of EMACS_INT */
65 #ifndef EMACS_INT_MAX
66 # if INTPTR_MAX <= 0
67 # error "INTPTR_MAX misconfigured"
68 # elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
69 typedef int EMACS_INT;
70 typedef unsigned int EMACS_UINT;
71 # define EMACS_INT_MAX INT_MAX
72 # define pI ""
73 # elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
74 typedef long int EMACS_INT;
75 typedef unsigned long EMACS_UINT;
76 # define EMACS_INT_MAX LONG_MAX
77 # define pI "l"
78 # elif INTPTR_MAX <= LLONG_MAX
79 typedef long long int EMACS_INT;
80 typedef unsigned long long int EMACS_UINT;
81 # define EMACS_INT_MAX LLONG_MAX
82 # define pI "ll"
83 # else
84 # error "INTPTR_MAX too large"
85 # endif
86 #endif
87
88 /* Number of bits to put in each character in the internal representation
89 of bool vectors. This should not vary across implementations. */
90 enum { BOOL_VECTOR_BITS_PER_CHAR =
91 #define BOOL_VECTOR_BITS_PER_CHAR 8
92 BOOL_VECTOR_BITS_PER_CHAR
93 };
94
95 /* An unsigned integer type representing a fixed-length bit sequence,
96 suitable for words in a Lisp bool vector. Normally it is size_t
97 for speed, but it is unsigned char on weird platforms. */
98 #if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
99 typedef size_t bits_word;
100 # define BITS_WORD_MAX SIZE_MAX
101 enum { BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word) };
102 #else
103 typedef unsigned char bits_word;
104 # define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
105 enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
106 #endif
107 verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
108
109 /* Number of bits in some machine integer types. */
110 enum
111 {
112 BITS_PER_CHAR = CHAR_BIT,
113 BITS_PER_SHORT = CHAR_BIT * sizeof (short),
114 BITS_PER_INT = CHAR_BIT * sizeof (int),
115 BITS_PER_LONG = CHAR_BIT * sizeof (long int),
116 BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
117 };
118
119 /* printmax_t and uprintmax_t are types for printing large integers.
120 These are the widest integers that are supported for printing.
121 pMd etc. are conversions for printing them.
122 On C99 hosts, there's no problem, as even the widest integers work.
123 Fall back on EMACS_INT on pre-C99 hosts. */
124 #ifdef PRIdMAX
125 typedef intmax_t printmax_t;
126 typedef uintmax_t uprintmax_t;
127 # define pMd PRIdMAX
128 # define pMu PRIuMAX
129 #else
130 typedef EMACS_INT printmax_t;
131 typedef EMACS_UINT uprintmax_t;
132 # define pMd pI"d"
133 # define pMu pI"u"
134 #endif
135
136 /* Use pD to format ptrdiff_t values, which suffice for indexes into
137 buffers and strings. Emacs never allocates objects larger than
138 PTRDIFF_MAX bytes, as they cause problems with pointer subtraction.
139 In C99, pD can always be "t"; configure it here for the sake of
140 pre-C99 libraries such as glibc 2.0 and Solaris 8. */
141 #if PTRDIFF_MAX == INT_MAX
142 # define pD ""
143 #elif PTRDIFF_MAX == LONG_MAX
144 # define pD "l"
145 #elif PTRDIFF_MAX == LLONG_MAX
146 # define pD "ll"
147 #else
148 # define pD "t"
149 #endif
150
151 /* Extra internal type checking? */
152
153 /* Define Emacs versions of <assert.h>'s 'assert (COND)' and <verify.h>'s
154 'assume (COND)'. COND should be free of side effects, as it may or
155 may not be evaluated.
156
157 'eassert (COND)' checks COND at runtime if ENABLE_CHECKING is
158 defined and suppress_checking is false, and does nothing otherwise.
159 Emacs dies if COND is checked and is false. The suppress_checking
160 variable is initialized to 0 in alloc.c. Set it to 1 using a
161 debugger to temporarily disable aborting on detected internal
162 inconsistencies or error conditions.
163
164 In some cases, a good compiler may be able to optimize away the
165 eassert macro even if ENABLE_CHECKING is true, e.g., if XSTRING (x)
166 uses eassert to test STRINGP (x), but a particular use of XSTRING
167 is invoked only after testing that STRINGP (x) is true, making the
168 test redundant.
169
170 eassume is like eassert except that it also causes the compiler to
171 assume that COND is true afterwards, regardless of whether runtime
172 checking is enabled. This can improve performance in some cases,
173 though it can degrade performance in others. It's often suboptimal
174 for COND to call external functions or access volatile storage. */
175
176 #ifndef ENABLE_CHECKING
177 # define eassert(cond) ((void) (false && (cond))) /* Check COND compiles. */
178 # define eassume(cond) assume (cond)
179 #else /* ENABLE_CHECKING */
180
181 extern _Noreturn void die (const char *, const char *, int);
182
183 extern bool suppress_checking EXTERNALLY_VISIBLE;
184
185 # define eassert(cond) \
186 (suppress_checking || (cond) \
187 ? (void) 0 \
188 : die (# cond, __FILE__, __LINE__))
189 # define eassume(cond) \
190 (suppress_checking \
191 ? assume (cond) \
192 : (cond) \
193 ? (void) 0 \
194 : die (# cond, __FILE__, __LINE__))
195 #endif /* ENABLE_CHECKING */
196
197 \f
198 /* Use the configure flag --enable-check-lisp-object-type to make
199 Lisp_Object use a struct type instead of the default int. The flag
200 causes CHECK_LISP_OBJECT_TYPE to be defined. */
201
202 /***** Select the tagging scheme. *****/
203 /* The following option controls the tagging scheme:
204 - USE_LSB_TAG means that we can assume the least 3 bits of pointers are
205 always 0, and we can thus use them to hold tag bits, without
206 restricting our addressing space.
207
208 If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
209 restricting our possible address range.
210
211 USE_LSB_TAG not only requires the least 3 bits of pointers returned by
212 malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
213 on the few static Lisp_Objects used: all the defsubr as well
214 as the two special buffers buffer_defaults and buffer_local_symbols. */
215
216 enum Lisp_Bits
217 {
218 /* Number of bits in a Lisp_Object tag. This can be used in #if,
219 and for GDB's sake also as a regular symbol. */
220 GCTYPEBITS =
221 #define GCTYPEBITS 3
222 GCTYPEBITS,
223
224 /* 2**GCTYPEBITS. This must be a macro that expands to a literal
225 integer constant, for MSVC. */
226 #define GCALIGNMENT 8
227
228 /* Number of bits in a Lisp_Object value, not counting the tag. */
229 VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
230
231 /* Number of bits in a Lisp fixnum tag. */
232 INTTYPEBITS = GCTYPEBITS - 1,
233
234 /* Number of bits in a Lisp fixnum value, not counting the tag. */
235 FIXNUM_BITS = VALBITS + 1
236 };
237
238 #if GCALIGNMENT != 1 << GCTYPEBITS
239 # error "GCALIGNMENT and GCTYPEBITS are inconsistent"
240 #endif
241
242 /* The maximum value that can be stored in a EMACS_INT, assuming all
243 bits other than the type bits contribute to a nonnegative signed value.
244 This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
245 #define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
246
247 /* Unless otherwise specified, use USE_LSB_TAG on systems where: */
248 #ifndef USE_LSB_TAG
249 /* 1. We know malloc returns a multiple of 8. */
250 # if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
251 || defined DARWIN_OS || defined __sun)
252 /* 2. We can specify multiple-of-8 alignment on static variables. */
253 # ifdef alignas
254 /* 3. Pointers-as-ints exceed VAL_MAX.
255 On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
256 a. unnecessary, because the top bits of an EMACS_INT are unused, and
257 b. slower, because it typically requires extra masking.
258 So, default USE_LSB_TAG to true only on hosts where it might be useful. */
259 # if VAL_MAX < UINTPTR_MAX
260 # define USE_LSB_TAG true
261 # endif
262 # endif
263 # endif
264 #endif
265 #ifdef USE_LSB_TAG
266 # undef USE_LSB_TAG
267 enum enum_USE_LSB_TAG { USE_LSB_TAG = true };
268 # define USE_LSB_TAG true
269 #else
270 enum enum_USE_LSB_TAG { USE_LSB_TAG = false };
271 # define USE_LSB_TAG false
272 #endif
273
274 #ifndef alignas
275 # define alignas(alignment) /* empty */
276 # if USE_LSB_TAG
277 # error "USE_LSB_TAG requires alignas"
278 # endif
279 #endif
280
281
282 /* Some operations are so commonly executed that they are implemented
283 as macros, not functions, because otherwise runtime performance would
284 suffer too much when compiling with GCC without optimization.
285 There's no need to inline everything, just the operations that
286 would otherwise cause a serious performance problem.
287
288 For each such operation OP, define a macro lisp_h_OP that contains
289 the operation's implementation. That way, OP can be implemented
290 via a macro definition like this:
291
292 #define OP(x) lisp_h_OP (x)
293
294 and/or via a function definition like this:
295
296 LISP_MACRO_DEFUN (OP, Lisp_Object, (Lisp_Object x), (x))
297
298 which macro-expands to this:
299
300 Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); }
301
302 without worrying about the implementations diverging, since
303 lisp_h_OP defines the actual implementation. The lisp_h_OP macros
304 are intended to be private to this include file, and should not be
305 used elsewhere.
306
307 FIXME: Remove the lisp_h_OP macros, and define just the inline OP
308 functions, once most developers have access to GCC 4.8 or later and
309 can use "gcc -Og" to debug. Maybe in the year 2016. See
310 Bug#11935.
311
312 Commentary for these macros can be found near their corresponding
313 functions, below. */
314
315 #if CHECK_LISP_OBJECT_TYPE
316 # define lisp_h_XLI(o) ((o).i)
317 # define lisp_h_XIL(i) ((Lisp_Object) { i })
318 #else
319 # define lisp_h_XLI(o) (o)
320 # define lisp_h_XIL(i) (i)
321 #endif
322 #define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
323 #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
324 #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
325 #define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \
326 ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x))
327 #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons)
328 #define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
329 #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float)
330 #define lisp_h_INTEGERP(x) ((XTYPE (x) & ~Lisp_Int1) == 0)
331 #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
332 #define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
333 #define lisp_h_NILP(x) EQ (x, Qnil)
334 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
335 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
336 #define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
337 #define lisp_h_SYMBOL_VAL(sym) \
338 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
339 #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
340 #define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
341 #define lisp_h_XCAR(c) XCONS (c)->car
342 #define lisp_h_XCDR(c) XCONS (c)->u.cdr
343 #define lisp_h_XCONS(a) \
344 (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
345 #define lisp_h_XHASH(a) XUINT (a)
346 #define lisp_h_XPNTR(a) \
347 ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS))
348 #define lisp_h_XSYMBOL(a) \
349 (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
350 #ifndef GC_CHECK_CONS_LIST
351 # define lisp_h_check_cons_list() ((void) 0)
352 #endif
353 #if USE_LSB_TAG
354 # define lisp_h_make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS)
355 # define lisp_h_XFASTINT(a) XINT (a)
356 # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
357 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
358 # define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type)))
359 #endif
360
361 /* When compiling via gcc -O0, define the key operations as macros, as
362 Emacs is too slow otherwise. To disable this optimization, compile
363 with -DINLINING=false. */
364 #if (defined __NO_INLINE__ \
365 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
366 && ! (defined INLINING && ! INLINING))
367 # define XLI(o) lisp_h_XLI (o)
368 # define XIL(i) lisp_h_XIL (i)
369 # define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
370 # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
371 # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
372 # define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x)
373 # define CONSP(x) lisp_h_CONSP (x)
374 # define EQ(x, y) lisp_h_EQ (x, y)
375 # define FLOATP(x) lisp_h_FLOATP (x)
376 # define INTEGERP(x) lisp_h_INTEGERP (x)
377 # define MARKERP(x) lisp_h_MARKERP (x)
378 # define MISCP(x) lisp_h_MISCP (x)
379 # define NILP(x) lisp_h_NILP (x)
380 # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
381 # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
382 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
383 # define SYMBOLP(x) lisp_h_SYMBOLP (x)
384 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
385 # define XCAR(c) lisp_h_XCAR (c)
386 # define XCDR(c) lisp_h_XCDR (c)
387 # define XCONS(a) lisp_h_XCONS (a)
388 # define XHASH(a) lisp_h_XHASH (a)
389 # define XPNTR(a) lisp_h_XPNTR (a)
390 # define XSYMBOL(a) lisp_h_XSYMBOL (a)
391 # ifndef GC_CHECK_CONS_LIST
392 # define check_cons_list() lisp_h_check_cons_list ()
393 # endif
394 # if USE_LSB_TAG
395 # define make_number(n) lisp_h_make_number (n)
396 # define XFASTINT(a) lisp_h_XFASTINT (a)
397 # define XINT(a) lisp_h_XINT (a)
398 # define XTYPE(a) lisp_h_XTYPE (a)
399 # define XUNTAG(a, type) lisp_h_XUNTAG (a, type)
400 # endif
401 #endif
402
403 /* Define NAME as a lisp.h inline function that returns TYPE and has
404 arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and
405 ARGS should be parenthesized. Implement the function by calling
406 lisp_h_NAME ARGS. */
407 #define LISP_MACRO_DEFUN(name, type, argdecls, args) \
408 INLINE type (name) argdecls { return lisp_h_##name args; }
409
410 /* like LISP_MACRO_DEFUN, except NAME returns void. */
411 #define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \
412 INLINE void (name) argdecls { lisp_h_##name args; }
413
414
415 /* Define the fundamental Lisp data structures. */
416
417 /* This is the set of Lisp data types. If you want to define a new
418 data type, read the comments after Lisp_Fwd_Type definition
419 below. */
420
421 /* Lisp integers use 2 tags, to give them one extra bit, thus
422 extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
423 #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
424 #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
425
426 /* Idea stolen from GDB. Pedantic GCC complains about enum bitfields,
427 MSVC doesn't support them, and xlc and Oracle Studio c99 complain
428 vociferously about them. */
429 #if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \
430 || (defined __SUNPRO_C && __STDC__))
431 #define ENUM_BF(TYPE) unsigned int
432 #else
433 #define ENUM_BF(TYPE) enum TYPE
434 #endif
435
436
437 enum Lisp_Type
438 {
439 /* Integer. XINT (obj) is the integer value. */
440 Lisp_Int0 = 0,
441 Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
442
443 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
444 Lisp_Symbol = 2,
445
446 /* Miscellaneous. XMISC (object) points to a union Lisp_Misc,
447 whose first member indicates the subtype. */
448 Lisp_Misc = 3,
449
450 /* String. XSTRING (object) points to a struct Lisp_String.
451 The length of the string, and its contents, are stored therein. */
452 Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
453
454 /* Vector of Lisp objects, or something resembling it.
455 XVECTOR (object) points to a struct Lisp_Vector, which contains
456 the size and contents. The size field also contains the type
457 information, if it's not a real vector object. */
458 Lisp_Vectorlike = 5,
459
460 /* Cons. XCONS (object) points to a struct Lisp_Cons. */
461 Lisp_Cons = 6,
462
463 Lisp_Float = 7
464 };
465
466 /* This is the set of data types that share a common structure.
467 The first member of the structure is a type code from this set.
468 The enum values are arbitrary, but we'll use large numbers to make it
469 more likely that we'll spot the error if a random word in memory is
470 mistakenly interpreted as a Lisp_Misc. */
471 enum Lisp_Misc_Type
472 {
473 Lisp_Misc_Free = 0x5eab,
474 Lisp_Misc_Marker,
475 Lisp_Misc_Overlay,
476 Lisp_Misc_Save_Value,
477 /* Currently floats are not a misc type,
478 but let's define this in case we want to change that. */
479 Lisp_Misc_Float,
480 /* This is not a type code. It is for range checking. */
481 Lisp_Misc_Limit
482 };
483
484 /* These are the types of forwarding objects used in the value slot
485 of symbols for special built-in variables whose value is stored in
486 C variables. */
487 enum Lisp_Fwd_Type
488 {
489 Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
490 Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
491 Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
492 Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
493 Lisp_Fwd_Kboard_Obj /* Fwd to a Lisp_Object field of kboards. */
494 };
495
496 /* If you want to define a new Lisp data type, here are some
497 instructions. See the thread at
498 http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00561.html
499 for more info.
500
501 First, there are already a couple of Lisp types that can be used if
502 your new type does not need to be exposed to Lisp programs nor
503 displayed to users. These are Lisp_Save_Value, a Lisp_Misc
504 subtype; and PVEC_OTHER, a kind of vectorlike object. The former
505 is suitable for temporarily stashing away pointers and integers in
506 a Lisp object. The latter is useful for vector-like Lisp objects
507 that need to be used as part of other objects, but which are never
508 shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
509 an example).
510
511 These two types don't look pretty when printed, so they are
512 unsuitable for Lisp objects that can be exposed to users.
513
514 To define a new data type, add one more Lisp_Misc subtype or one
515 more pseudovector subtype. Pseudovectors are more suitable for
516 objects with several slots that need to support fast random access,
517 while Lisp_Misc types are for everything else. A pseudovector object
518 provides one or more slots for Lisp objects, followed by struct
519 members that are accessible only from C. A Lisp_Misc object is a
520 wrapper for a C struct that can contain anything you like.
521
522 Explicit freeing is discouraged for Lisp objects in general. But if
523 you really need to exploit this, use Lisp_Misc (check free_misc in
524 alloc.c to see why). There is no way to free a vectorlike object.
525
526 To add a new pseudovector type, extend the pvec_type enumeration;
527 to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration.
528
529 For a Lisp_Misc, you will also need to add your entry to union
530 Lisp_Misc (but make sure the first word has the same structure as
531 the others, starting with a 16-bit member of the Lisp_Misc_Type
532 enumeration and a 1-bit GC markbit) and make sure the overall size
533 of the union is not increased by your addition.
534
535 For a new pseudovector, it's highly desirable to limit the size
536 of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c).
537 Otherwise you will need to change sweep_vectors (also in alloc.c).
538
539 Then you will need to add switch branches in print.c (in
540 print_object, to print your object, and possibly also in
541 print_preprocess) and to alloc.c, to mark your object (in
542 mark_object) and to free it (in gc_sweep). The latter is also the
543 right place to call any code specific to your data type that needs
544 to run when the object is recycled -- e.g., free any additional
545 resources allocated for it that are not Lisp objects. You can even
546 make a pointer to the function that frees the resources a slot in
547 your object -- this way, the same object could be used to represent
548 several disparate C structures. */
549
550 #ifdef CHECK_LISP_OBJECT_TYPE
551
552 typedef struct { EMACS_INT i; } Lisp_Object;
553
554 #define LISP_INITIALLY_ZERO {0}
555
556 #undef CHECK_LISP_OBJECT_TYPE
557 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
558 #else /* CHECK_LISP_OBJECT_TYPE */
559
560 /* If a struct type is not wanted, define Lisp_Object as just a number. */
561
562 typedef EMACS_INT Lisp_Object;
563 #define LISP_INITIALLY_ZERO 0
564 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
565 #endif /* CHECK_LISP_OBJECT_TYPE */
566
567 /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
568 At the machine level, these operations are no-ops. */
569 LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o))
570 LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i))
571
572 /* In the size word of a vector, this bit means the vector has been marked. */
573
574 DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
575 #define ARRAY_MARK_FLAG PTRDIFF_MIN
576 DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
577
578 /* In the size word of a struct Lisp_Vector, this bit means it's really
579 some other vector-like object. */
580 DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
581 #define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
582 DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
583
584 /* In a pseudovector, the size field actually contains a word with one
585 PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
586 with PVEC_TYPE_MASK to indicate the actual type. */
587 enum pvec_type
588 {
589 PVEC_NORMAL_VECTOR,
590 PVEC_FREE,
591 PVEC_PROCESS,
592 PVEC_FRAME,
593 PVEC_WINDOW,
594 PVEC_BOOL_VECTOR,
595 PVEC_BUFFER,
596 PVEC_HASH_TABLE,
597 PVEC_TERMINAL,
598 PVEC_WINDOW_CONFIGURATION,
599 PVEC_SUBR,
600 PVEC_OTHER,
601 /* These should be last, check internal_equal to see why. */
602 PVEC_COMPILED,
603 PVEC_CHAR_TABLE,
604 PVEC_SUB_CHAR_TABLE,
605 PVEC_FONT /* Should be last because it's used for range checking. */
606 };
607
608 /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
609 which were stored in a Lisp_Object. */
610 #ifndef DATA_SEG_BITS
611 # define DATA_SEG_BITS 0
612 #endif
613 enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
614 #undef DATA_SEG_BITS
615
616 enum More_Lisp_Bits
617 {
618 DATA_SEG_BITS = gdb_DATA_SEG_BITS,
619
620 /* For convenience, we also store the number of elements in these bits.
621 Note that this size is not necessarily the memory-footprint size, but
622 only the number of Lisp_Object fields (that need to be traced by GC).
623 The distinction is used, e.g., by Lisp_Process, which places extra
624 non-Lisp_Object fields at the end of the structure. */
625 PSEUDOVECTOR_SIZE_BITS = 12,
626 PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
627
628 /* To calculate the memory footprint of the pseudovector, it's useful
629 to store the size of non-Lisp area in word_size units here. */
630 PSEUDOVECTOR_REST_BITS = 12,
631 PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
632 << PSEUDOVECTOR_SIZE_BITS),
633
634 /* Used to extract pseudovector subtype information. */
635 PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
636 PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
637 };
638 \f
639 /* These functions extract various sorts of values from a Lisp_Object.
640 For example, if tem is a Lisp_Object whose type is Lisp_Cons,
641 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for
642 that cons. */
643
644 DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
645 #define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
646 DEFINE_GDB_SYMBOL_END (VALMASK)
647
648 /* Largest and smallest representable fixnum values. These are the C
649 values. They are macros for use in static initializers. */
650 #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
651 #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
652
653 /* Extract the pointer hidden within A. */
654 LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a))
655
656 #if USE_LSB_TAG
657
658 LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n))
659 LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a))
660 LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a))
661 LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a))
662 LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type))
663
664 #else /* ! USE_LSB_TAG */
665
666 /* Although compiled only if ! USE_LSB_TAG, the following functions
667 also work when USE_LSB_TAG; this is to aid future maintenance when
668 the lisp_h_* macros are eventually removed. */
669
670 /* Make a Lisp integer representing the value of the low order
671 bits of N. */
672 INLINE Lisp_Object
673 make_number (EMACS_INT n)
674 {
675 return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK);
676 }
677
678 /* Extract A's value as a signed integer. */
679 INLINE EMACS_INT
680 XINT (Lisp_Object a)
681 {
682 EMACS_INT i = XLI (a);
683 return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS;
684 }
685
686 /* Like XINT (A), but may be faster. A must be nonnegative.
687 If ! USE_LSB_TAG, this takes advantage of the fact that Lisp
688 integers have zero-bits in their tags. */
689 INLINE EMACS_INT
690 XFASTINT (Lisp_Object a)
691 {
692 EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a);
693 eassert (0 <= n);
694 return n;
695 }
696
697 /* Extract A's type. */
698 INLINE enum Lisp_Type
699 XTYPE (Lisp_Object a)
700 {
701 EMACS_UINT i = XLI (a);
702 return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
703 }
704
705 /* Extract A's pointer value, assuming A's type is TYPE. */
706 INLINE void *
707 XUNTAG (Lisp_Object a, int type)
708 {
709 if (USE_LSB_TAG)
710 {
711 intptr_t i = XLI (a) - type;
712 return (void *) i;
713 }
714 return XPNTR (a);
715 }
716
717 #endif /* ! USE_LSB_TAG */
718
719 /* Extract A's value as an unsigned integer. */
720 INLINE EMACS_UINT
721 XUINT (Lisp_Object a)
722 {
723 EMACS_UINT i = XLI (a);
724 return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
725 }
726
727 /* Return A's (Lisp-integer sized) hash. Happens to be like XUINT
728 right now, but XUINT should only be applied to objects we know are
729 integers. */
730 LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a))
731
732 /* Like make_number (N), but may be faster. N must be in nonnegative range. */
733 INLINE Lisp_Object
734 make_natnum (EMACS_INT n)
735 {
736 eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
737 return USE_LSB_TAG ? make_number (n) : XIL (n);
738 }
739
740 /* Return true if X and Y are the same object. */
741 LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y))
742
743 /* Value is true if I doesn't fit into a Lisp fixnum. It is
744 written this way so that it also works if I is of unsigned
745 type or if I is a NaN. */
746
747 #define FIXNUM_OVERFLOW_P(i) \
748 (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
749
750 INLINE ptrdiff_t
751 clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
752 {
753 return num < lower ? lower : num <= upper ? num : upper;
754 }
755 \f
756 /* Forward declarations. */
757
758 /* Defined in this file. */
759 union Lisp_Fwd;
760 INLINE bool BOOL_VECTOR_P (Lisp_Object);
761 INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
762 INLINE bool BUFFERP (Lisp_Object);
763 INLINE bool CHAR_TABLE_P (Lisp_Object);
764 INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
765 INLINE bool (CONSP) (Lisp_Object);
766 INLINE bool (FLOATP) (Lisp_Object);
767 INLINE bool functionp (Lisp_Object);
768 INLINE bool (INTEGERP) (Lisp_Object);
769 INLINE bool (MARKERP) (Lisp_Object);
770 INLINE bool (MISCP) (Lisp_Object);
771 INLINE bool (NILP) (Lisp_Object);
772 INLINE bool OVERLAYP (Lisp_Object);
773 INLINE bool PROCESSP (Lisp_Object);
774 INLINE bool PSEUDOVECTORP (Lisp_Object, int);
775 INLINE bool SAVE_VALUEP (Lisp_Object);
776 INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
777 Lisp_Object);
778 INLINE bool STRINGP (Lisp_Object);
779 INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
780 INLINE bool SUBRP (Lisp_Object);
781 INLINE bool (SYMBOLP) (Lisp_Object);
782 INLINE bool (VECTORLIKEP) (Lisp_Object);
783 INLINE bool WINDOWP (Lisp_Object);
784 INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
785
786 /* Defined in chartab.c. */
787 extern Lisp_Object char_table_ref (Lisp_Object, int);
788 extern void char_table_set (Lisp_Object, int, Lisp_Object);
789 extern int char_table_translate (Lisp_Object, int);
790
791 /* Defined in data.c. */
792 extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
793 extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
794 extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp;
795 extern Lisp_Object Qbool_vector_p;
796 extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
797 extern Lisp_Object Qwindow;
798 extern Lisp_Object Ffboundp (Lisp_Object);
799 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
800
801 /* Defined in emacs.c. */
802 extern bool initialized;
803
804 /* Defined in eval.c. */
805 extern Lisp_Object Qautoload;
806
807 /* Defined in floatfns.c. */
808 extern double extract_float (Lisp_Object);
809
810 /* Defined in process.c. */
811 extern Lisp_Object Qprocessp;
812
813 /* Defined in window.c. */
814 extern Lisp_Object Qwindowp;
815
816 /* Defined in xdisp.c. */
817 extern Lisp_Object Qimage;
818 \f
819
820 /* Extract a value or address from a Lisp_Object. */
821
822 LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a))
823
824 INLINE struct Lisp_Vector *
825 XVECTOR (Lisp_Object a)
826 {
827 eassert (VECTORLIKEP (a));
828 return XUNTAG (a, Lisp_Vectorlike);
829 }
830
831 INLINE struct Lisp_String *
832 XSTRING (Lisp_Object a)
833 {
834 eassert (STRINGP (a));
835 return XUNTAG (a, Lisp_String);
836 }
837
838 LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
839
840 INLINE struct Lisp_Float *
841 XFLOAT (Lisp_Object a)
842 {
843 eassert (FLOATP (a));
844 return XUNTAG (a, Lisp_Float);
845 }
846
847 /* Pseudovector types. */
848
849 INLINE struct Lisp_Process *
850 XPROCESS (Lisp_Object a)
851 {
852 eassert (PROCESSP (a));
853 return XUNTAG (a, Lisp_Vectorlike);
854 }
855
856 INLINE struct window *
857 XWINDOW (Lisp_Object a)
858 {
859 eassert (WINDOWP (a));
860 return XUNTAG (a, Lisp_Vectorlike);
861 }
862
863 INLINE struct terminal *
864 XTERMINAL (Lisp_Object a)
865 {
866 return XUNTAG (a, Lisp_Vectorlike);
867 }
868
869 INLINE struct Lisp_Subr *
870 XSUBR (Lisp_Object a)
871 {
872 eassert (SUBRP (a));
873 return XUNTAG (a, Lisp_Vectorlike);
874 }
875
876 INLINE struct buffer *
877 XBUFFER (Lisp_Object a)
878 {
879 eassert (BUFFERP (a));
880 return XUNTAG (a, Lisp_Vectorlike);
881 }
882
883 INLINE struct Lisp_Char_Table *
884 XCHAR_TABLE (Lisp_Object a)
885 {
886 eassert (CHAR_TABLE_P (a));
887 return XUNTAG (a, Lisp_Vectorlike);
888 }
889
890 INLINE struct Lisp_Sub_Char_Table *
891 XSUB_CHAR_TABLE (Lisp_Object a)
892 {
893 eassert (SUB_CHAR_TABLE_P (a));
894 return XUNTAG (a, Lisp_Vectorlike);
895 }
896
897 INLINE struct Lisp_Bool_Vector *
898 XBOOL_VECTOR (Lisp_Object a)
899 {
900 eassert (BOOL_VECTOR_P (a));
901 return XUNTAG (a, Lisp_Vectorlike);
902 }
903
904 /* Construct a Lisp_Object from a value or address. */
905
906 INLINE Lisp_Object
907 make_lisp_ptr (void *ptr, enum Lisp_Type type)
908 {
909 EMACS_UINT utype = type;
910 EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS;
911 Lisp_Object a = XIL (typebits | (uintptr_t) ptr);
912 eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
913 return a;
914 }
915
916 INLINE Lisp_Object
917 make_lisp_proc (struct Lisp_Process *p)
918 {
919 return make_lisp_ptr (p, Lisp_Vectorlike);
920 }
921
922 #define XSETINT(a, b) ((a) = make_number (b))
923 #define XSETFASTINT(a, b) ((a) = make_natnum (b))
924 #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
925 #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
926 #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
927 #define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol))
928 #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
929 #define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
930
931 /* Pseudovector types. */
932
933 #define XSETPVECTYPE(v, code) \
934 ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))
935 #define XSETPVECTYPESIZE(v, code, lispsize, restsize) \
936 ((v)->header.size = (PSEUDOVECTOR_FLAG \
937 | ((code) << PSEUDOVECTOR_AREA_BITS) \
938 | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \
939 | (lispsize)))
940
941 /* The cast to struct vectorlike_header * avoids aliasing issues. */
942 #define XSETPSEUDOVECTOR(a, b, code) \
943 XSETTYPED_PSEUDOVECTOR (a, b, \
944 (((struct vectorlike_header *) \
945 XUNTAG (a, Lisp_Vectorlike)) \
946 ->size), \
947 code)
948 #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
949 (XSETVECTOR (a, b), \
950 eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
951 == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
952
953 #define XSETWINDOW_CONFIGURATION(a, b) \
954 (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
955 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
956 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
957 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
958 #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
959 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
960 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
961 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
962 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
963 #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
964
965 /* Type checking. */
966
967 LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x),
968 (ok, Qxxxp, x))
969
970 /* Deprecated and will be removed soon. */
971
972 #define INTERNAL_FIELD(field) field ## _
973
974 /* See the macros in intervals.h. */
975
976 typedef struct interval *INTERVAL;
977
978 struct Lisp_Cons
979 {
980 /* Car of this cons cell. */
981 Lisp_Object car;
982
983 union
984 {
985 /* Cdr of this cons cell. */
986 Lisp_Object cdr;
987
988 /* Used to chain conses on a free list. */
989 struct Lisp_Cons *chain;
990 } u;
991 };
992
993 /* Take the car or cdr of something known to be a cons cell. */
994 /* The _addr functions shouldn't be used outside of the minimal set
995 of code that has to know what a cons cell looks like. Other code not
996 part of the basic lisp implementation should assume that the car and cdr
997 fields are not accessible. (What if we want to switch to
998 a copying collector someday? Cached cons cell field addresses may be
999 invalidated at arbitrary points.) */
1000 INLINE Lisp_Object *
1001 xcar_addr (Lisp_Object c)
1002 {
1003 return &XCONS (c)->car;
1004 }
1005 INLINE Lisp_Object *
1006 xcdr_addr (Lisp_Object c)
1007 {
1008 return &XCONS (c)->u.cdr;
1009 }
1010
1011 /* Use these from normal code. */
1012 LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c))
1013 LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
1014
1015 /* Use these to set the fields of a cons cell.
1016
1017 Note that both arguments may refer to the same object, so 'n'
1018 should not be read after 'c' is first modified. */
1019 INLINE void
1020 XSETCAR (Lisp_Object c, Lisp_Object n)
1021 {
1022 *xcar_addr (c) = n;
1023 }
1024 INLINE void
1025 XSETCDR (Lisp_Object c, Lisp_Object n)
1026 {
1027 *xcdr_addr (c) = n;
1028 }
1029
1030 /* Take the car or cdr of something whose type is not known. */
1031 INLINE Lisp_Object
1032 CAR (Lisp_Object c)
1033 {
1034 return (CONSP (c) ? XCAR (c)
1035 : NILP (c) ? Qnil
1036 : wrong_type_argument (Qlistp, c));
1037 }
1038 INLINE Lisp_Object
1039 CDR (Lisp_Object c)
1040 {
1041 return (CONSP (c) ? XCDR (c)
1042 : NILP (c) ? Qnil
1043 : wrong_type_argument (Qlistp, c));
1044 }
1045
1046 /* Take the car or cdr of something whose type is not known. */
1047 INLINE Lisp_Object
1048 CAR_SAFE (Lisp_Object c)
1049 {
1050 return CONSP (c) ? XCAR (c) : Qnil;
1051 }
1052 INLINE Lisp_Object
1053 CDR_SAFE (Lisp_Object c)
1054 {
1055 return CONSP (c) ? XCDR (c) : Qnil;
1056 }
1057
1058 /* In a string or vector, the sign bit of the `size' is the gc mark bit. */
1059
1060 struct Lisp_String
1061 {
1062 ptrdiff_t size;
1063 ptrdiff_t size_byte;
1064 INTERVAL intervals; /* Text properties in this string. */
1065 unsigned char *data;
1066 };
1067
1068 /* True if STR is a multibyte string. */
1069 INLINE bool
1070 STRING_MULTIBYTE (Lisp_Object str)
1071 {
1072 return 0 <= XSTRING (str)->size_byte;
1073 }
1074
1075 /* An upper bound on the number of bytes in a Lisp string, not
1076 counting the terminating null. This a tight enough bound to
1077 prevent integer overflow errors that would otherwise occur during
1078 string size calculations. A string cannot contain more bytes than
1079 a fixnum can represent, nor can it be so long that C pointer
1080 arithmetic stops working on the string plus its terminating null.
1081 Although the actual size limit (see STRING_BYTES_MAX in alloc.c)
1082 may be a bit smaller than STRING_BYTES_BOUND, calculating it here
1083 would expose alloc.c internal details that we'd rather keep
1084 private.
1085
1086 This is a macro for use in static initializers. The cast to
1087 ptrdiff_t ensures that the macro is signed. */
1088 #define STRING_BYTES_BOUND \
1089 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
1090
1091 /* Mark STR as a unibyte string. */
1092 #define STRING_SET_UNIBYTE(STR) \
1093 do { \
1094 if (EQ (STR, empty_multibyte_string)) \
1095 (STR) = empty_unibyte_string; \
1096 else \
1097 XSTRING (STR)->size_byte = -1; \
1098 } while (false)
1099
1100 /* Mark STR as a multibyte string. Assure that STR contains only
1101 ASCII characters in advance. */
1102 #define STRING_SET_MULTIBYTE(STR) \
1103 do { \
1104 if (EQ (STR, empty_unibyte_string)) \
1105 (STR) = empty_multibyte_string; \
1106 else \
1107 XSTRING (STR)->size_byte = XSTRING (STR)->size; \
1108 } while (false)
1109
1110 /* Convenience functions for dealing with Lisp strings. */
1111
1112 INLINE unsigned char *
1113 SDATA (Lisp_Object string)
1114 {
1115 return XSTRING (string)->data;
1116 }
1117 INLINE char *
1118 SSDATA (Lisp_Object string)
1119 {
1120 /* Avoid "differ in sign" warnings. */
1121 return (char *) SDATA (string);
1122 }
1123 INLINE unsigned char
1124 SREF (Lisp_Object string, ptrdiff_t index)
1125 {
1126 return SDATA (string)[index];
1127 }
1128 INLINE void
1129 SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
1130 {
1131 SDATA (string)[index] = new;
1132 }
1133 INLINE ptrdiff_t
1134 SCHARS (Lisp_Object string)
1135 {
1136 return XSTRING (string)->size;
1137 }
1138
1139 #ifdef GC_CHECK_STRING_BYTES
1140 extern ptrdiff_t string_bytes (struct Lisp_String *);
1141 #endif
1142 INLINE ptrdiff_t
1143 STRING_BYTES (struct Lisp_String *s)
1144 {
1145 #ifdef GC_CHECK_STRING_BYTES
1146 return string_bytes (s);
1147 #else
1148 return s->size_byte < 0 ? s->size : s->size_byte;
1149 #endif
1150 }
1151
1152 INLINE ptrdiff_t
1153 SBYTES (Lisp_Object string)
1154 {
1155 return STRING_BYTES (XSTRING (string));
1156 }
1157 INLINE void
1158 STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
1159 {
1160 XSTRING (string)->size = newsize;
1161 }
1162 INLINE void
1163 STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new,
1164 ptrdiff_t count)
1165 {
1166 memcpy (SDATA (string) + index, new, count);
1167 }
1168
1169 /* Header of vector-like objects. This documents the layout constraints on
1170 vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
1171 compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
1172 and PSEUDOVECTORP cast their pointers to struct vectorlike_header *,
1173 because when two such pointers potentially alias, a compiler won't
1174 incorrectly reorder loads and stores to their size fields. See
1175 Bug#8546. */
1176 struct vectorlike_header
1177 {
1178 /* The only field contains various pieces of information:
1179 - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
1180 - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
1181 vector (0) or a pseudovector (1).
1182 - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
1183 of slots) of the vector.
1184 - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields:
1185 - a) pseudovector subtype held in PVEC_TYPE_MASK field;
1186 - b) number of Lisp_Objects slots at the beginning of the object
1187 held in PSEUDOVECTOR_SIZE_MASK field. These objects are always
1188 traced by the GC;
1189 - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and
1190 measured in word_size units. Rest fields may also include
1191 Lisp_Objects, but these objects usually needs some special treatment
1192 during GC.
1193 There are some exceptions. For PVEC_FREE, b) is always zero. For
1194 PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero.
1195 Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
1196 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
1197 ptrdiff_t size;
1198 };
1199
1200 /* A regular vector is just a header plus an array of Lisp_Objects. */
1201
1202 struct Lisp_Vector
1203 {
1204 struct vectorlike_header header;
1205 Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
1206 };
1207
1208 /* C11 prohibits alignof (struct Lisp_Vector), so compute it manually. */
1209 enum
1210 {
1211 ALIGNOF_STRUCT_LISP_VECTOR
1212 = alignof (union { struct vectorlike_header a; Lisp_Object b; })
1213 };
1214
1215 /* A boolvector is a kind of vectorlike, with contents like a string. */
1216
1217 struct Lisp_Bool_Vector
1218 {
1219 /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
1220 just the subtype information. */
1221 struct vectorlike_header header;
1222 /* This is the size in bits. */
1223 EMACS_INT size;
1224 /* The actual bits, packed into bytes.
1225 Zeros fill out the last word if needed.
1226 The bits are in little-endian order in the bytes, and
1227 the bytes are in little-endian order in the words. */
1228 bits_word data[FLEXIBLE_ARRAY_MEMBER];
1229 };
1230
1231 INLINE EMACS_INT
1232 bool_vector_size (Lisp_Object a)
1233 {
1234 EMACS_INT size = XBOOL_VECTOR (a)->size;
1235 eassume (0 <= size);
1236 return size;
1237 }
1238
1239 INLINE bits_word *
1240 bool_vector_data (Lisp_Object a)
1241 {
1242 return XBOOL_VECTOR (a)->data;
1243 }
1244
1245 INLINE unsigned char *
1246 bool_vector_uchar_data (Lisp_Object a)
1247 {
1248 return (unsigned char *) bool_vector_data (a);
1249 }
1250
1251 /* The number of data words and bytes in a bool vector with SIZE bits. */
1252
1253 INLINE EMACS_INT
1254 bool_vector_words (EMACS_INT size)
1255 {
1256 eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
1257 return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD;
1258 }
1259
1260 INLINE EMACS_INT
1261 bool_vector_bytes (EMACS_INT size)
1262 {
1263 eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
1264 return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
1265 }
1266
1267 /* True if A's Ith bit is set. */
1268
1269 INLINE bool
1270 bool_vector_bitref (Lisp_Object a, EMACS_INT i)
1271 {
1272 eassume (0 <= i && i < bool_vector_size (a));
1273 return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
1274 & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
1275 }
1276
1277 INLINE Lisp_Object
1278 bool_vector_ref (Lisp_Object a, EMACS_INT i)
1279 {
1280 return bool_vector_bitref (a, i) ? Qt : Qnil;
1281 }
1282
1283 /* Set A's Ith bit to B. */
1284
1285 INLINE void
1286 bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
1287 {
1288 unsigned char *addr;
1289
1290 eassume (0 <= i && i < bool_vector_size (a));
1291 addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
1292
1293 if (b)
1294 *addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
1295 else
1296 *addr &= ~ (1 << (i % BOOL_VECTOR_BITS_PER_CHAR));
1297 }
1298
1299 /* Some handy constants for calculating sizes
1300 and offsets, mostly of vectorlike objects. */
1301
1302 enum
1303 {
1304 header_size = offsetof (struct Lisp_Vector, contents),
1305 bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
1306 word_size = sizeof (Lisp_Object)
1307 };
1308
1309 /* Conveniences for dealing with Lisp arrays. */
1310
1311 INLINE Lisp_Object
1312 AREF (Lisp_Object array, ptrdiff_t idx)
1313 {
1314 return XVECTOR (array)->contents[idx];
1315 }
1316
1317 INLINE Lisp_Object *
1318 aref_addr (Lisp_Object array, ptrdiff_t idx)
1319 {
1320 return & XVECTOR (array)->contents[idx];
1321 }
1322
1323 INLINE ptrdiff_t
1324 ASIZE (Lisp_Object array)
1325 {
1326 return XVECTOR (array)->header.size;
1327 }
1328
1329 INLINE void
1330 ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1331 {
1332 eassert (0 <= idx && idx < ASIZE (array));
1333 XVECTOR (array)->contents[idx] = val;
1334 }
1335
1336 INLINE void
1337 gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1338 {
1339 /* Like ASET, but also can be used in the garbage collector:
1340 sweep_weak_table calls set_hash_key etc. while the table is marked. */
1341 eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
1342 XVECTOR (array)->contents[idx] = val;
1343 }
1344
1345 /* If a struct is made to look like a vector, this macro returns the length
1346 of the shortest vector that would hold that struct. */
1347
1348 #define VECSIZE(type) \
1349 ((sizeof (type) - header_size + word_size - 1) / word_size)
1350
1351 /* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
1352 at the end and we need to compute the number of Lisp_Object fields (the
1353 ones that the GC needs to trace). */
1354
1355 #define PSEUDOVECSIZE(type, nonlispfield) \
1356 ((offsetof (type, nonlispfield) - header_size) / word_size)
1357
1358 /* Compute A OP B, using the unsigned comparison operator OP. A and B
1359 should be integer expressions. This is not the same as
1360 mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
1361 returns true. For efficiency, prefer plain unsigned comparison if A
1362 and B's sizes both fit (after integer promotion). */
1363 #define UNSIGNED_CMP(a, op, b) \
1364 (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \
1365 ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \
1366 : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
1367
1368 /* True iff C is an ASCII character. */
1369 #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
1370
1371 /* A char-table is a kind of vectorlike, with contents are like a
1372 vector but with a few other slots. For some purposes, it makes
1373 sense to handle a char-table with type struct Lisp_Vector. An
1374 element of a char table can be any Lisp objects, but if it is a sub
1375 char-table, we treat it a table that contains information of a
1376 specific range of characters. A sub char-table has the same
1377 structure as a vector. A sub char table appears only in an element
1378 of a char-table, and there's no way to access it directly from
1379 Emacs Lisp program. */
1380
1381 enum CHARTAB_SIZE_BITS
1382 {
1383 CHARTAB_SIZE_BITS_0 = 6,
1384 CHARTAB_SIZE_BITS_1 = 4,
1385 CHARTAB_SIZE_BITS_2 = 5,
1386 CHARTAB_SIZE_BITS_3 = 7
1387 };
1388
1389 extern const int chartab_size[4];
1390
1391 struct Lisp_Char_Table
1392 {
1393 /* HEADER.SIZE is the vector's size field, which also holds the
1394 pseudovector type information. It holds the size, too.
1395 The size counts the defalt, parent, purpose, ascii,
1396 contents, and extras slots. */
1397 struct vectorlike_header header;
1398
1399 /* This holds a default value,
1400 which is used whenever the value for a specific character is nil. */
1401 Lisp_Object defalt;
1402
1403 /* This points to another char table, which we inherit from when the
1404 value for a specific character is nil. The `defalt' slot takes
1405 precedence over this. */
1406 Lisp_Object parent;
1407
1408 /* This is a symbol which says what kind of use this char-table is
1409 meant for. */
1410 Lisp_Object purpose;
1411
1412 /* The bottom sub char-table for characters of the range 0..127. It
1413 is nil if none of ASCII character has a specific value. */
1414 Lisp_Object ascii;
1415
1416 Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
1417
1418 /* These hold additional data. It is a vector. */
1419 Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER];
1420 };
1421
1422 struct Lisp_Sub_Char_Table
1423 {
1424 /* HEADER.SIZE is the vector's size field, which also holds the
1425 pseudovector type information. It holds the size, too. */
1426 struct vectorlike_header header;
1427
1428 /* Depth of this sub char-table. It should be 1, 2, or 3. A sub
1429 char-table of depth 1 contains 16 elements, and each element
1430 covers 4096 (128*32) characters. A sub char-table of depth 2
1431 contains 32 elements, and each element covers 128 characters. A
1432 sub char-table of depth 3 contains 128 elements, and each element
1433 is for one character. */
1434 Lisp_Object depth;
1435
1436 /* Minimum character covered by the sub char-table. */
1437 Lisp_Object min_char;
1438
1439 /* Use set_sub_char_table_contents to set this. */
1440 Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
1441 };
1442
1443 INLINE Lisp_Object
1444 CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
1445 {
1446 struct Lisp_Char_Table *tbl = NULL;
1447 Lisp_Object val;
1448 do
1449 {
1450 tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct);
1451 val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii
1452 : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]);
1453 if (NILP (val))
1454 val = tbl->defalt;
1455 }
1456 while (NILP (val) && ! NILP (tbl->parent));
1457
1458 return val;
1459 }
1460
1461 /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
1462 characters. Do not check validity of CT. */
1463 INLINE Lisp_Object
1464 CHAR_TABLE_REF (Lisp_Object ct, int idx)
1465 {
1466 return (ASCII_CHAR_P (idx)
1467 ? CHAR_TABLE_REF_ASCII (ct, idx)
1468 : char_table_ref (ct, idx));
1469 }
1470
1471 /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
1472 8-bit European characters. Do not check validity of CT. */
1473 INLINE void
1474 CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
1475 {
1476 if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii))
1477 set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val);
1478 else
1479 char_table_set (ct, idx, val);
1480 }
1481
1482 /* This structure describes a built-in function.
1483 It is generated by the DEFUN macro only.
1484 defsubr makes it into a Lisp object. */
1485
1486 struct Lisp_Subr
1487 {
1488 struct vectorlike_header header;
1489 union {
1490 Lisp_Object (*a0) (void);
1491 Lisp_Object (*a1) (Lisp_Object);
1492 Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
1493 Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object);
1494 Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1495 Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1496 Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1497 Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1498 Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
1499 Lisp_Object (*aUNEVALLED) (Lisp_Object args);
1500 Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
1501 } function;
1502 short min_args, max_args;
1503 const char *symbol_name;
1504 const char *intspec;
1505 const char *doc;
1506 };
1507
1508 /* This is the number of slots that every char table must have. This
1509 counts the ordinary slots and the top, defalt, parent, and purpose
1510 slots. */
1511 enum CHAR_TABLE_STANDARD_SLOTS
1512 {
1513 CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras)
1514 };
1515
1516 /* Return the number of "extra" slots in the char table CT. */
1517
1518 INLINE int
1519 CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
1520 {
1521 return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK)
1522 - CHAR_TABLE_STANDARD_SLOTS);
1523 }
1524
1525 \f
1526 /***********************************************************************
1527 Symbols
1528 ***********************************************************************/
1529
1530 /* Interned state of a symbol. */
1531
1532 enum symbol_interned
1533 {
1534 SYMBOL_UNINTERNED = 0,
1535 SYMBOL_INTERNED = 1,
1536 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
1537 };
1538
1539 enum symbol_redirect
1540 {
1541 SYMBOL_PLAINVAL = 4,
1542 SYMBOL_VARALIAS = 1,
1543 SYMBOL_LOCALIZED = 2,
1544 SYMBOL_FORWARDED = 3
1545 };
1546
1547 struct Lisp_Symbol
1548 {
1549 bool_bf gcmarkbit : 1;
1550
1551 /* Indicates where the value can be found:
1552 0 : it's a plain var, the value is in the `value' field.
1553 1 : it's a varalias, the value is really in the `alias' symbol.
1554 2 : it's a localized var, the value is in the `blv' object.
1555 3 : it's a forwarding variable, the value is in `forward'. */
1556 ENUM_BF (symbol_redirect) redirect : 3;
1557
1558 /* Non-zero means symbol is constant, i.e. changing its value
1559 should signal an error. If the value is 3, then the var
1560 can be changed, but only by `defconst'. */
1561 unsigned constant : 2;
1562
1563 /* Interned state of the symbol. This is an enumerator from
1564 enum symbol_interned. */
1565 unsigned interned : 2;
1566
1567 /* True means that this variable has been explicitly declared
1568 special (with `defvar' etc), and shouldn't be lexically bound. */
1569 bool_bf declared_special : 1;
1570
1571 /* The symbol's name, as a Lisp string. */
1572 Lisp_Object name;
1573
1574 /* Value of the symbol or Qunbound if unbound. Which alternative of the
1575 union is used depends on the `redirect' field above. */
1576 union {
1577 Lisp_Object value;
1578 struct Lisp_Symbol *alias;
1579 struct Lisp_Buffer_Local_Value *blv;
1580 union Lisp_Fwd *fwd;
1581 } val;
1582
1583 /* Function value of the symbol or Qnil if not fboundp. */
1584 Lisp_Object function;
1585
1586 /* The symbol's property list. */
1587 Lisp_Object plist;
1588
1589 /* Next symbol in obarray bucket, if the symbol is interned. */
1590 struct Lisp_Symbol *next;
1591 };
1592
1593 /* Value is name of symbol. */
1594
1595 LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
1596
1597 INLINE struct Lisp_Symbol *
1598 SYMBOL_ALIAS (struct Lisp_Symbol *sym)
1599 {
1600 eassert (sym->redirect == SYMBOL_VARALIAS);
1601 return sym->val.alias;
1602 }
1603 INLINE struct Lisp_Buffer_Local_Value *
1604 SYMBOL_BLV (struct Lisp_Symbol *sym)
1605 {
1606 eassert (sym->redirect == SYMBOL_LOCALIZED);
1607 return sym->val.blv;
1608 }
1609 INLINE union Lisp_Fwd *
1610 SYMBOL_FWD (struct Lisp_Symbol *sym)
1611 {
1612 eassert (sym->redirect == SYMBOL_FORWARDED);
1613 return sym->val.fwd;
1614 }
1615
1616 LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL,
1617 (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v))
1618
1619 INLINE void
1620 SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
1621 {
1622 eassert (sym->redirect == SYMBOL_VARALIAS);
1623 sym->val.alias = v;
1624 }
1625 INLINE void
1626 SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
1627 {
1628 eassert (sym->redirect == SYMBOL_LOCALIZED);
1629 sym->val.blv = v;
1630 }
1631 INLINE void
1632 SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
1633 {
1634 eassert (sym->redirect == SYMBOL_FORWARDED);
1635 sym->val.fwd = v;
1636 }
1637
1638 INLINE Lisp_Object
1639 SYMBOL_NAME (Lisp_Object sym)
1640 {
1641 return XSYMBOL (sym)->name;
1642 }
1643
1644 /* Value is true if SYM is an interned symbol. */
1645
1646 INLINE bool
1647 SYMBOL_INTERNED_P (Lisp_Object sym)
1648 {
1649 return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
1650 }
1651
1652 /* Value is true if SYM is interned in initial_obarray. */
1653
1654 INLINE bool
1655 SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
1656 {
1657 return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
1658 }
1659
1660 /* Value is non-zero if symbol is considered a constant, i.e. its
1661 value cannot be changed (there is an exception for keyword symbols,
1662 whose value can be set to the keyword symbol itself). */
1663
1664 LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym))
1665
1666 #define DEFSYM(sym, name) \
1667 do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false)
1668
1669 \f
1670 /***********************************************************************
1671 Hash Tables
1672 ***********************************************************************/
1673
1674 /* The structure of a Lisp hash table. */
1675
1676 struct hash_table_test
1677 {
1678 /* Name of the function used to compare keys. */
1679 Lisp_Object name;
1680
1681 /* User-supplied hash function, or nil. */
1682 Lisp_Object user_hash_function;
1683
1684 /* User-supplied key comparison function, or nil. */
1685 Lisp_Object user_cmp_function;
1686
1687 /* C function to compare two keys. */
1688 bool (*cmpfn) (struct hash_table_test *t, Lisp_Object, Lisp_Object);
1689
1690 /* C function to compute hash code. */
1691 EMACS_UINT (*hashfn) (struct hash_table_test *t, Lisp_Object);
1692 };
1693
1694 struct Lisp_Hash_Table
1695 {
1696 /* This is for Lisp; the hash table code does not refer to it. */
1697 struct vectorlike_header header;
1698
1699 /* Nil if table is non-weak. Otherwise a symbol describing the
1700 weakness of the table. */
1701 Lisp_Object weak;
1702
1703 /* When the table is resized, and this is an integer, compute the
1704 new size by adding this to the old size. If a float, compute the
1705 new size by multiplying the old size with this factor. */
1706 Lisp_Object rehash_size;
1707
1708 /* Resize hash table when number of entries/ table size is >= this
1709 ratio, a float. */
1710 Lisp_Object rehash_threshold;
1711
1712 /* Vector of hash codes.. If hash[I] is nil, this means that that
1713 entry I is unused. */
1714 Lisp_Object hash;
1715
1716 /* Vector used to chain entries. If entry I is free, next[I] is the
1717 entry number of the next free item. If entry I is non-free,
1718 next[I] is the index of the next entry in the collision chain. */
1719 Lisp_Object next;
1720
1721 /* Index of first free entry in free list. */
1722 Lisp_Object next_free;
1723
1724 /* Bucket vector. A non-nil entry is the index of the first item in
1725 a collision chain. This vector's size can be larger than the
1726 hash table size to reduce collisions. */
1727 Lisp_Object index;
1728
1729 /* Only the fields above are traced normally by the GC. The ones below
1730 `count' are special and are either ignored by the GC or traced in
1731 a special way (e.g. because of weakness). */
1732
1733 /* Number of key/value entries in the table. */
1734 ptrdiff_t count;
1735
1736 /* Vector of keys and values. The key of item I is found at index
1737 2 * I, the value is found at index 2 * I + 1.
1738 This is gc_marked specially if the table is weak. */
1739 Lisp_Object key_and_value;
1740
1741 /* The comparison and hash functions. */
1742 struct hash_table_test test;
1743
1744 /* Next weak hash table if this is a weak hash table. The head
1745 of the list is in weak_hash_tables. */
1746 struct Lisp_Hash_Table *next_weak;
1747 };
1748
1749
1750 INLINE struct Lisp_Hash_Table *
1751 XHASH_TABLE (Lisp_Object a)
1752 {
1753 return XUNTAG (a, Lisp_Vectorlike);
1754 }
1755
1756 #define XSET_HASH_TABLE(VAR, PTR) \
1757 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
1758
1759 INLINE bool
1760 HASH_TABLE_P (Lisp_Object a)
1761 {
1762 return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
1763 }
1764
1765 /* Value is the key part of entry IDX in hash table H. */
1766 INLINE Lisp_Object
1767 HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1768 {
1769 return AREF (h->key_and_value, 2 * idx);
1770 }
1771
1772 /* Value is the value part of entry IDX in hash table H. */
1773 INLINE Lisp_Object
1774 HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1775 {
1776 return AREF (h->key_and_value, 2 * idx + 1);
1777 }
1778
1779 /* Value is the index of the next entry following the one at IDX
1780 in hash table H. */
1781 INLINE Lisp_Object
1782 HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1783 {
1784 return AREF (h->next, idx);
1785 }
1786
1787 /* Value is the hash code computed for entry IDX in hash table H. */
1788 INLINE Lisp_Object
1789 HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1790 {
1791 return AREF (h->hash, idx);
1792 }
1793
1794 /* Value is the index of the element in hash table H that is the
1795 start of the collision list at index IDX in the index vector of H. */
1796 INLINE Lisp_Object
1797 HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
1798 {
1799 return AREF (h->index, idx);
1800 }
1801
1802 /* Value is the size of hash table H. */
1803 INLINE ptrdiff_t
1804 HASH_TABLE_SIZE (struct Lisp_Hash_Table *h)
1805 {
1806 return ASIZE (h->next);
1807 }
1808
1809 /* Default size for hash tables if not specified. */
1810
1811 enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
1812
1813 /* Default threshold specifying when to resize a hash table. The
1814 value gives the ratio of current entries in the hash table and the
1815 size of the hash table. */
1816
1817 static double const DEFAULT_REHASH_THRESHOLD = 0.8;
1818
1819 /* Default factor by which to increase the size of a hash table. */
1820
1821 static double const DEFAULT_REHASH_SIZE = 1.5;
1822
1823 /* Combine two integers X and Y for hashing. The result might not fit
1824 into a Lisp integer. */
1825
1826 INLINE EMACS_UINT
1827 sxhash_combine (EMACS_UINT x, EMACS_UINT y)
1828 {
1829 return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y;
1830 }
1831
1832 /* Hash X, returning a value that fits into a fixnum. */
1833
1834 INLINE EMACS_UINT
1835 SXHASH_REDUCE (EMACS_UINT x)
1836 {
1837 return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS)) & INTMASK;
1838 }
1839
1840 /* These structures are used for various misc types. */
1841
1842 struct Lisp_Misc_Any /* Supertype of all Misc types. */
1843 {
1844 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
1845 bool_bf gcmarkbit : 1;
1846 unsigned spacer : 15;
1847 };
1848
1849 struct Lisp_Marker
1850 {
1851 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */
1852 bool_bf gcmarkbit : 1;
1853 unsigned spacer : 13;
1854 /* This flag is temporarily used in the functions
1855 decode/encode_coding_object to record that the marker position
1856 must be adjusted after the conversion. */
1857 bool_bf need_adjustment : 1;
1858 /* True means normal insertion at the marker's position
1859 leaves the marker after the inserted text. */
1860 bool_bf insertion_type : 1;
1861 /* This is the buffer that the marker points into, or 0 if it points nowhere.
1862 Note: a chain of markers can contain markers pointing into different
1863 buffers (the chain is per buffer_text rather than per buffer, so it's
1864 shared between indirect buffers). */
1865 /* This is used for (other than NULL-checking):
1866 - Fmarker_buffer
1867 - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
1868 - unchain_marker: to find the list from which to unchain.
1869 - Fkill_buffer: to only unchain the markers of current indirect buffer.
1870 */
1871 struct buffer *buffer;
1872
1873 /* The remaining fields are meaningless in a marker that
1874 does not point anywhere. */
1875
1876 /* For markers that point somewhere,
1877 this is used to chain of all the markers in a given buffer. */
1878 /* We could remove it and use an array in buffer_text instead.
1879 That would also allow to preserve it ordered. */
1880 struct Lisp_Marker *next;
1881 /* This is the char position where the marker points. */
1882 ptrdiff_t charpos;
1883 /* This is the byte position.
1884 It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
1885 used to implement the functionality of markers, but rather to (ab)use
1886 markers as a cache for char<->byte mappings). */
1887 ptrdiff_t bytepos;
1888 };
1889
1890 /* START and END are markers in the overlay's buffer, and
1891 PLIST is the overlay's property list. */
1892 struct Lisp_Overlay
1893 /* An overlay's real data content is:
1894 - plist
1895 - buffer (really there are two buffer pointers, one per marker,
1896 and both points to the same buffer)
1897 - insertion type of both ends (per-marker fields)
1898 - start & start byte (of start marker)
1899 - end & end byte (of end marker)
1900 - next (singly linked list of overlays)
1901 - next fields of start and end markers (singly linked list of markers).
1902 I.e. 9words plus 2 bits, 3words of which are for external linked lists.
1903 */
1904 {
1905 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
1906 bool_bf gcmarkbit : 1;
1907 unsigned spacer : 15;
1908 struct Lisp_Overlay *next;
1909 Lisp_Object start;
1910 Lisp_Object end;
1911 Lisp_Object plist;
1912 };
1913
1914 /* Types of data which may be saved in a Lisp_Save_Value. */
1915
1916 enum
1917 {
1918 SAVE_UNUSED,
1919 SAVE_INTEGER,
1920 SAVE_FUNCPOINTER,
1921 SAVE_POINTER,
1922 SAVE_OBJECT
1923 };
1924
1925 /* Number of bits needed to store one of the above values. */
1926 enum { SAVE_SLOT_BITS = 3 };
1927
1928 /* Number of slots in a save value where save_type is nonzero. */
1929 enum { SAVE_VALUE_SLOTS = 4 };
1930
1931 /* Bit-width and values for struct Lisp_Save_Value's save_type member. */
1932
1933 enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 };
1934
1935 enum Lisp_Save_Type
1936 {
1937 SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS),
1938 SAVE_TYPE_INT_INT_INT
1939 = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)),
1940 SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS),
1941 SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS),
1942 SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
1943 = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS),
1944 SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS),
1945 SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS),
1946 SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS),
1947 SAVE_TYPE_FUNCPTR_PTR_OBJ
1948 = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS),
1949
1950 /* This has an extra bit indicating it's raw memory. */
1951 SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1))
1952 };
1953
1954 /* Special object used to hold a different values for later use.
1955
1956 This is mostly used to package C integers and pointers to call
1957 record_unwind_protect when two or more values need to be saved.
1958 For example:
1959
1960 ...
1961 struct my_data *md = get_my_data ();
1962 ptrdiff_t mi = get_my_integer ();
1963 record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
1964 ...
1965
1966 Lisp_Object my_unwind (Lisp_Object arg)
1967 {
1968 struct my_data *md = XSAVE_POINTER (arg, 0);
1969 ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
1970 ...
1971 }
1972
1973 If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
1974 saved objects and raise eassert if type of the saved object doesn't match
1975 the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
1976 and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
1977 slot 0 is a pointer. */
1978
1979 typedef void (*voidfuncptr) (void);
1980
1981 struct Lisp_Save_Value
1982 {
1983 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
1984 bool_bf gcmarkbit : 1;
1985 unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
1986
1987 /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
1988 V's data entries are determined by V->save_type. E.g., if
1989 V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
1990 V->data[1] is an integer, and V's other data entries are unused.
1991
1992 If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
1993 a memory area containing V->data[1].integer potential Lisp_Objects. */
1994 ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
1995 union {
1996 void *pointer;
1997 voidfuncptr funcpointer;
1998 ptrdiff_t integer;
1999 Lisp_Object object;
2000 } data[SAVE_VALUE_SLOTS];
2001 };
2002
2003 /* Return the type of V's Nth saved value. */
2004 INLINE int
2005 save_type (struct Lisp_Save_Value *v, int n)
2006 {
2007 eassert (0 <= n && n < SAVE_VALUE_SLOTS);
2008 return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
2009 }
2010
2011 /* Get and set the Nth saved pointer. */
2012
2013 INLINE void *
2014 XSAVE_POINTER (Lisp_Object obj, int n)
2015 {
2016 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
2017 return XSAVE_VALUE (obj)->data[n].pointer;
2018 }
2019 INLINE void
2020 set_save_pointer (Lisp_Object obj, int n, void *val)
2021 {
2022 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
2023 XSAVE_VALUE (obj)->data[n].pointer = val;
2024 }
2025 INLINE voidfuncptr
2026 XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
2027 {
2028 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER);
2029 return XSAVE_VALUE (obj)->data[n].funcpointer;
2030 }
2031
2032 /* Likewise for the saved integer. */
2033
2034 INLINE ptrdiff_t
2035 XSAVE_INTEGER (Lisp_Object obj, int n)
2036 {
2037 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
2038 return XSAVE_VALUE (obj)->data[n].integer;
2039 }
2040 INLINE void
2041 set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
2042 {
2043 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
2044 XSAVE_VALUE (obj)->data[n].integer = val;
2045 }
2046
2047 /* Extract Nth saved object. */
2048
2049 INLINE Lisp_Object
2050 XSAVE_OBJECT (Lisp_Object obj, int n)
2051 {
2052 eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
2053 return XSAVE_VALUE (obj)->data[n].object;
2054 }
2055
2056 /* A miscellaneous object, when it's on the free list. */
2057 struct Lisp_Free
2058 {
2059 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
2060 bool_bf gcmarkbit : 1;
2061 unsigned spacer : 15;
2062 union Lisp_Misc *chain;
2063 };
2064
2065 /* To get the type field of a union Lisp_Misc, use XMISCTYPE.
2066 It uses one of these struct subtypes to get the type field. */
2067
2068 union Lisp_Misc
2069 {
2070 struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
2071 struct Lisp_Free u_free;
2072 struct Lisp_Marker u_marker;
2073 struct Lisp_Overlay u_overlay;
2074 struct Lisp_Save_Value u_save_value;
2075 };
2076
2077 INLINE union Lisp_Misc *
2078 XMISC (Lisp_Object a)
2079 {
2080 return XUNTAG (a, Lisp_Misc);
2081 }
2082
2083 INLINE struct Lisp_Misc_Any *
2084 XMISCANY (Lisp_Object a)
2085 {
2086 eassert (MISCP (a));
2087 return & XMISC (a)->u_any;
2088 }
2089
2090 INLINE enum Lisp_Misc_Type
2091 XMISCTYPE (Lisp_Object a)
2092 {
2093 return XMISCANY (a)->type;
2094 }
2095
2096 INLINE struct Lisp_Marker *
2097 XMARKER (Lisp_Object a)
2098 {
2099 eassert (MARKERP (a));
2100 return & XMISC (a)->u_marker;
2101 }
2102
2103 INLINE struct Lisp_Overlay *
2104 XOVERLAY (Lisp_Object a)
2105 {
2106 eassert (OVERLAYP (a));
2107 return & XMISC (a)->u_overlay;
2108 }
2109
2110 INLINE struct Lisp_Save_Value *
2111 XSAVE_VALUE (Lisp_Object a)
2112 {
2113 eassert (SAVE_VALUEP (a));
2114 return & XMISC (a)->u_save_value;
2115 }
2116 \f
2117 /* Forwarding pointer to an int variable.
2118 This is allowed only in the value cell of a symbol,
2119 and it means that the symbol's value really lives in the
2120 specified int variable. */
2121 struct Lisp_Intfwd
2122 {
2123 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
2124 EMACS_INT *intvar;
2125 };
2126
2127 /* Boolean forwarding pointer to an int variable.
2128 This is like Lisp_Intfwd except that the ostensible
2129 "value" of the symbol is t if the bool variable is true,
2130 nil if it is false. */
2131 struct Lisp_Boolfwd
2132 {
2133 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
2134 bool *boolvar;
2135 };
2136
2137 /* Forwarding pointer to a Lisp_Object variable.
2138 This is allowed only in the value cell of a symbol,
2139 and it means that the symbol's value really lives in the
2140 specified variable. */
2141 struct Lisp_Objfwd
2142 {
2143 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
2144 Lisp_Object *objvar;
2145 };
2146
2147 /* Like Lisp_Objfwd except that value lives in a slot in the
2148 current buffer. Value is byte index of slot within buffer. */
2149 struct Lisp_Buffer_Objfwd
2150 {
2151 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
2152 int offset;
2153 /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */
2154 Lisp_Object predicate;
2155 };
2156
2157 /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
2158 the symbol has buffer-local or frame-local bindings. (Exception:
2159 some buffer-local variables are built-in, with their values stored
2160 in the buffer structure itself. They are handled differently,
2161 using struct Lisp_Buffer_Objfwd.)
2162
2163 The `realvalue' slot holds the variable's current value, or a
2164 forwarding pointer to where that value is kept. This value is the
2165 one that corresponds to the loaded binding. To read or set the
2166 variable, you must first make sure the right binding is loaded;
2167 then you can access the value in (or through) `realvalue'.
2168
2169 `buffer' and `frame' are the buffer and frame for which the loaded
2170 binding was found. If those have changed, to make sure the right
2171 binding is loaded it is necessary to find which binding goes with
2172 the current buffer and selected frame, then load it. To load it,
2173 first unload the previous binding, then copy the value of the new
2174 binding into `realvalue' (or through it). Also update
2175 LOADED-BINDING to point to the newly loaded binding.
2176
2177 `local_if_set' indicates that merely setting the variable creates a
2178 local binding for the current buffer. Otherwise the latter, setting
2179 the variable does not do that; only make-local-variable does that. */
2180
2181 struct Lisp_Buffer_Local_Value
2182 {
2183 /* True means that merely setting the variable creates a local
2184 binding for the current buffer. */
2185 bool_bf local_if_set : 1;
2186 /* True means this variable can have frame-local bindings, otherwise, it is
2187 can have buffer-local bindings. The two cannot be combined. */
2188 bool_bf frame_local : 1;
2189 /* True means that the binding now loaded was found.
2190 Presumably equivalent to (defcell!=valcell). */
2191 bool_bf found : 1;
2192 /* If non-NULL, a forwarding to the C var where it should also be set. */
2193 union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
2194 /* The buffer or frame for which the loaded binding was found. */
2195 Lisp_Object where;
2196 /* A cons cell that holds the default value. It has the form
2197 (SYMBOL . DEFAULT-VALUE). */
2198 Lisp_Object defcell;
2199 /* The cons cell from `where's parameter alist.
2200 It always has the form (SYMBOL . VALUE)
2201 Note that if `forward' is non-nil, VALUE may be out of date.
2202 Also if the currently loaded binding is the default binding, then
2203 this is `eq'ual to defcell. */
2204 Lisp_Object valcell;
2205 };
2206
2207 /* Like Lisp_Objfwd except that value lives in a slot in the
2208 current kboard. */
2209 struct Lisp_Kboard_Objfwd
2210 {
2211 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */
2212 int offset;
2213 };
2214
2215 union Lisp_Fwd
2216 {
2217 struct Lisp_Intfwd u_intfwd;
2218 struct Lisp_Boolfwd u_boolfwd;
2219 struct Lisp_Objfwd u_objfwd;
2220 struct Lisp_Buffer_Objfwd u_buffer_objfwd;
2221 struct Lisp_Kboard_Objfwd u_kboard_objfwd;
2222 };
2223
2224 INLINE enum Lisp_Fwd_Type
2225 XFWDTYPE (union Lisp_Fwd *a)
2226 {
2227 return a->u_intfwd.type;
2228 }
2229
2230 INLINE struct Lisp_Buffer_Objfwd *
2231 XBUFFER_OBJFWD (union Lisp_Fwd *a)
2232 {
2233 eassert (BUFFER_OBJFWDP (a));
2234 return &a->u_buffer_objfwd;
2235 }
2236 \f
2237 /* Lisp floating point type. */
2238 struct Lisp_Float
2239 {
2240 union
2241 {
2242 double data;
2243 struct Lisp_Float *chain;
2244 } u;
2245 };
2246
2247 INLINE double
2248 XFLOAT_DATA (Lisp_Object f)
2249 {
2250 return XFLOAT (f)->u.data;
2251 }
2252
2253 /* Most hosts nowadays use IEEE floating point, so they use IEC 60559
2254 representations, have infinities and NaNs, and do not trap on
2255 exceptions. Define IEEE_FLOATING_POINT if this host is one of the
2256 typical ones. The C11 macro __STDC_IEC_559__ is close to what is
2257 wanted here, but is not quite right because Emacs does not require
2258 all the features of C11 Annex F (and does not require C11 at all,
2259 for that matter). */
2260 enum
2261 {
2262 IEEE_FLOATING_POINT
2263 = (FLT_RADIX == 2 && FLT_MANT_DIG == 24
2264 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
2265 };
2266
2267 /* A character, declared with the following typedef, is a member
2268 of some character set associated with the current buffer. */
2269 #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */
2270 #define _UCHAR_T
2271 typedef unsigned char UCHAR;
2272 #endif
2273
2274 /* Meanings of slots in a Lisp_Compiled: */
2275
2276 enum Lisp_Compiled
2277 {
2278 COMPILED_ARGLIST = 0,
2279 COMPILED_BYTECODE = 1,
2280 COMPILED_CONSTANTS = 2,
2281 COMPILED_STACK_DEPTH = 3,
2282 COMPILED_DOC_STRING = 4,
2283 COMPILED_INTERACTIVE = 5
2284 };
2285
2286 /* Flag bits in a character. These also get used in termhooks.h.
2287 Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
2288 (MUlti-Lingual Emacs) might need 22 bits for the character value
2289 itself, so we probably shouldn't use any bits lower than 0x0400000. */
2290 enum char_bits
2291 {
2292 CHAR_ALT = 0x0400000,
2293 CHAR_SUPER = 0x0800000,
2294 CHAR_HYPER = 0x1000000,
2295 CHAR_SHIFT = 0x2000000,
2296 CHAR_CTL = 0x4000000,
2297 CHAR_META = 0x8000000,
2298
2299 CHAR_MODIFIER_MASK =
2300 CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META,
2301
2302 /* Actually, the current Emacs uses 22 bits for the character value
2303 itself. */
2304 CHARACTERBITS = 22
2305 };
2306 \f
2307 /* Data type checking. */
2308
2309 LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x))
2310
2311 INLINE bool
2312 NUMBERP (Lisp_Object x)
2313 {
2314 return INTEGERP (x) || FLOATP (x);
2315 }
2316 INLINE bool
2317 NATNUMP (Lisp_Object x)
2318 {
2319 return INTEGERP (x) && 0 <= XINT (x);
2320 }
2321
2322 INLINE bool
2323 RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi)
2324 {
2325 return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi;
2326 }
2327
2328 #define TYPE_RANGED_INTEGERP(type, x) \
2329 (INTEGERP (x) \
2330 && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \
2331 && XINT (x) <= TYPE_MAXIMUM (type))
2332
2333 LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x))
2334 LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x))
2335 LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x))
2336 LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x))
2337 LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x))
2338 LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x))
2339 LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x))
2340
2341 INLINE bool
2342 STRINGP (Lisp_Object x)
2343 {
2344 return XTYPE (x) == Lisp_String;
2345 }
2346 INLINE bool
2347 VECTORP (Lisp_Object x)
2348 {
2349 return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG);
2350 }
2351 INLINE bool
2352 OVERLAYP (Lisp_Object x)
2353 {
2354 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay;
2355 }
2356 INLINE bool
2357 SAVE_VALUEP (Lisp_Object x)
2358 {
2359 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
2360 }
2361
2362 INLINE bool
2363 AUTOLOADP (Lisp_Object x)
2364 {
2365 return CONSP (x) && EQ (Qautoload, XCAR (x));
2366 }
2367
2368 INLINE bool
2369 BUFFER_OBJFWDP (union Lisp_Fwd *a)
2370 {
2371 return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
2372 }
2373
2374 INLINE bool
2375 PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code)
2376 {
2377 return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
2378 == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
2379 }
2380
2381 /* True if A is a pseudovector whose code is CODE. */
2382 INLINE bool
2383 PSEUDOVECTORP (Lisp_Object a, int code)
2384 {
2385 if (! VECTORLIKEP (a))
2386 return false;
2387 else
2388 {
2389 /* Converting to struct vectorlike_header * avoids aliasing issues. */
2390 struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike);
2391 return PSEUDOVECTOR_TYPEP (h, code);
2392 }
2393 }
2394
2395
2396 /* Test for specific pseudovector types. */
2397
2398 INLINE bool
2399 WINDOW_CONFIGURATIONP (Lisp_Object a)
2400 {
2401 return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION);
2402 }
2403
2404 INLINE bool
2405 PROCESSP (Lisp_Object a)
2406 {
2407 return PSEUDOVECTORP (a, PVEC_PROCESS);
2408 }
2409
2410 INLINE bool
2411 WINDOWP (Lisp_Object a)
2412 {
2413 return PSEUDOVECTORP (a, PVEC_WINDOW);
2414 }
2415
2416 INLINE bool
2417 TERMINALP (Lisp_Object a)
2418 {
2419 return PSEUDOVECTORP (a, PVEC_TERMINAL);
2420 }
2421
2422 INLINE bool
2423 SUBRP (Lisp_Object a)
2424 {
2425 return PSEUDOVECTORP (a, PVEC_SUBR);
2426 }
2427
2428 INLINE bool
2429 COMPILEDP (Lisp_Object a)
2430 {
2431 return PSEUDOVECTORP (a, PVEC_COMPILED);
2432 }
2433
2434 INLINE bool
2435 BUFFERP (Lisp_Object a)
2436 {
2437 return PSEUDOVECTORP (a, PVEC_BUFFER);
2438 }
2439
2440 INLINE bool
2441 CHAR_TABLE_P (Lisp_Object a)
2442 {
2443 return PSEUDOVECTORP (a, PVEC_CHAR_TABLE);
2444 }
2445
2446 INLINE bool
2447 SUB_CHAR_TABLE_P (Lisp_Object a)
2448 {
2449 return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE);
2450 }
2451
2452 INLINE bool
2453 BOOL_VECTOR_P (Lisp_Object a)
2454 {
2455 return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR);
2456 }
2457
2458 INLINE bool
2459 FRAMEP (Lisp_Object a)
2460 {
2461 return PSEUDOVECTORP (a, PVEC_FRAME);
2462 }
2463
2464 /* Test for image (image . spec) */
2465 INLINE bool
2466 IMAGEP (Lisp_Object x)
2467 {
2468 return CONSP (x) && EQ (XCAR (x), Qimage);
2469 }
2470
2471 /* Array types. */
2472 INLINE bool
2473 ARRAYP (Lisp_Object x)
2474 {
2475 return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x);
2476 }
2477 \f
2478 INLINE void
2479 CHECK_LIST (Lisp_Object x)
2480 {
2481 CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x);
2482 }
2483
2484 LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y))
2485 LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x))
2486 LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x))
2487
2488 INLINE void
2489 CHECK_STRING (Lisp_Object x)
2490 {
2491 CHECK_TYPE (STRINGP (x), Qstringp, x);
2492 }
2493 INLINE void
2494 CHECK_STRING_CAR (Lisp_Object x)
2495 {
2496 CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
2497 }
2498 INLINE void
2499 CHECK_CONS (Lisp_Object x)
2500 {
2501 CHECK_TYPE (CONSP (x), Qconsp, x);
2502 }
2503 INLINE void
2504 CHECK_VECTOR (Lisp_Object x)
2505 {
2506 CHECK_TYPE (VECTORP (x), Qvectorp, x);
2507 }
2508 INLINE void
2509 CHECK_BOOL_VECTOR (Lisp_Object x)
2510 {
2511 CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x);
2512 }
2513 INLINE void
2514 CHECK_VECTOR_OR_STRING (Lisp_Object x)
2515 {
2516 CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
2517 }
2518 INLINE void
2519 CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp)
2520 {
2521 CHECK_TYPE (ARRAYP (x), Qxxxp, x);
2522 }
2523 INLINE void
2524 CHECK_BUFFER (Lisp_Object x)
2525 {
2526 CHECK_TYPE (BUFFERP (x), Qbufferp, x);
2527 }
2528 INLINE void
2529 CHECK_WINDOW (Lisp_Object x)
2530 {
2531 CHECK_TYPE (WINDOWP (x), Qwindowp, x);
2532 }
2533 INLINE void
2534 CHECK_PROCESS (Lisp_Object x)
2535 {
2536 CHECK_TYPE (PROCESSP (x), Qprocessp, x);
2537 }
2538 INLINE void
2539 CHECK_NATNUM (Lisp_Object x)
2540 {
2541 CHECK_TYPE (NATNUMP (x), Qwholenump, x);
2542 }
2543
2544 #define CHECK_RANGED_INTEGER(x, lo, hi) \
2545 do { \
2546 CHECK_NUMBER (x); \
2547 if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \
2548 args_out_of_range_3 \
2549 (x, \
2550 make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \
2551 ? MOST_NEGATIVE_FIXNUM \
2552 : (lo)), \
2553 make_number (min (hi, MOST_POSITIVE_FIXNUM))); \
2554 } while (false)
2555 #define CHECK_TYPE_RANGED_INTEGER(type, x) \
2556 do { \
2557 if (TYPE_SIGNED (type)) \
2558 CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
2559 else \
2560 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
2561 } while (false)
2562
2563 #define CHECK_NUMBER_COERCE_MARKER(x) \
2564 do { \
2565 if (MARKERP ((x))) \
2566 XSETFASTINT (x, marker_position (x)); \
2567 else \
2568 CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); \
2569 } while (false)
2570
2571 INLINE double
2572 XFLOATINT (Lisp_Object n)
2573 {
2574 return extract_float (n);
2575 }
2576
2577 INLINE void
2578 CHECK_NUMBER_OR_FLOAT (Lisp_Object x)
2579 {
2580 CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x);
2581 }
2582
2583 #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
2584 do { \
2585 if (MARKERP (x)) \
2586 XSETFASTINT (x, marker_position (x)); \
2587 else \
2588 CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); \
2589 } while (false)
2590
2591 /* Since we can't assign directly to the CAR or CDR fields of a cons
2592 cell, use these when checking that those fields contain numbers. */
2593 INLINE void
2594 CHECK_NUMBER_CAR (Lisp_Object x)
2595 {
2596 Lisp_Object tmp = XCAR (x);
2597 CHECK_NUMBER (tmp);
2598 XSETCAR (x, tmp);
2599 }
2600
2601 INLINE void
2602 CHECK_NUMBER_CDR (Lisp_Object x)
2603 {
2604 Lisp_Object tmp = XCDR (x);
2605 CHECK_NUMBER (tmp);
2606 XSETCDR (x, tmp);
2607 }
2608 \f
2609 /* Define a built-in function for calling from Lisp.
2610 `lname' should be the name to give the function in Lisp,
2611 as a null-terminated C string.
2612 `fnname' should be the name of the function in C.
2613 By convention, it starts with F.
2614 `sname' should be the name for the C constant structure
2615 that records information on this function for internal use.
2616 By convention, it should be the same as `fnname' but with S instead of F.
2617 It's too bad that C macros can't compute this from `fnname'.
2618 `minargs' should be a number, the minimum number of arguments allowed.
2619 `maxargs' should be a number, the maximum number of arguments allowed,
2620 or else MANY or UNEVALLED.
2621 MANY means pass a vector of evaluated arguments,
2622 in the form of an integer number-of-arguments
2623 followed by the address of a vector of Lisp_Objects
2624 which contains the argument values.
2625 UNEVALLED means pass the list of unevaluated arguments
2626 `intspec' says how interactive arguments are to be fetched.
2627 If the string starts with a `(', `intspec' is evaluated and the resulting
2628 list is the list of arguments.
2629 If it's a string that doesn't start with `(', the value should follow
2630 the one of the doc string for `interactive'.
2631 A null string means call interactively with no arguments.
2632 `doc' is documentation for the user. */
2633
2634 /* This version of DEFUN declares a function prototype with the right
2635 arguments, so we can catch errors with maxargs at compile-time. */
2636 #ifdef _MSC_VER
2637 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
2638 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
2639 static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
2640 { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \
2641 | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \
2642 { (Lisp_Object (__cdecl *)(void))fnname }, \
2643 minargs, maxargs, lname, intspec, 0}; \
2644 Lisp_Object fnname
2645 #else /* not _MSC_VER */
2646 # if __STDC_VERSION__ < 199901
2647 # define DEFUN_FUNCTION_INIT(fnname, maxargs) (Lisp_Object (*) (void)) fnname
2648 # else
2649 # define DEFUN_FUNCTION_INIT(fnname, maxargs) .a ## maxargs = fnname
2650 # endif
2651 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
2652 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
2653 static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
2654 { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
2655 { DEFUN_FUNCTION_INIT (fnname, maxargs) }, \
2656 minargs, maxargs, lname, intspec, 0}; \
2657 Lisp_Object fnname
2658 #endif
2659
2660 /* Note that the weird token-substitution semantics of ANSI C makes
2661 this work for MANY and UNEVALLED. */
2662 #define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
2663 #define DEFUN_ARGS_UNEVALLED (Lisp_Object)
2664 #define DEFUN_ARGS_0 (void)
2665 #define DEFUN_ARGS_1 (Lisp_Object)
2666 #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
2667 #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
2668 #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
2669 #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
2670 Lisp_Object)
2671 #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
2672 Lisp_Object, Lisp_Object)
2673 #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
2674 Lisp_Object, Lisp_Object, Lisp_Object)
2675 #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
2676 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
2677
2678 /* True if OBJ is a Lisp function. */
2679 INLINE bool
2680 FUNCTIONP (Lisp_Object obj)
2681 {
2682 return functionp (obj);
2683 }
2684
2685 /* defsubr (Sname);
2686 is how we define the symbol for function `name' at start-up time. */
2687 extern void defsubr (struct Lisp_Subr *);
2688
2689 enum maxargs
2690 {
2691 MANY = -2,
2692 UNEVALLED = -1
2693 };
2694
2695 extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
2696 extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
2697 extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *);
2698 extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
2699 extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
2700
2701 /* Macros we use to define forwarded Lisp variables.
2702 These are used in the syms_of_FILENAME functions.
2703
2704 An ordinary (not in buffer_defaults, per-buffer, or per-keyboard)
2705 lisp variable is actually a field in `struct emacs_globals'. The
2706 field's name begins with "f_", which is a convention enforced by
2707 these macros. Each such global has a corresponding #define in
2708 globals.h; the plain name should be used in the code.
2709
2710 E.g., the global "cons_cells_consed" is declared as "int
2711 f_cons_cells_consed" in globals.h, but there is a define:
2712
2713 #define cons_cells_consed globals.f_cons_cells_consed
2714
2715 All C code uses the `cons_cells_consed' name. This is all done
2716 this way to support indirection for multi-threaded Emacs. */
2717
2718 #define DEFVAR_LISP(lname, vname, doc) \
2719 do { \
2720 static struct Lisp_Objfwd o_fwd; \
2721 defvar_lisp (&o_fwd, lname, &globals.f_ ## vname); \
2722 } while (false)
2723 #define DEFVAR_LISP_NOPRO(lname, vname, doc) \
2724 do { \
2725 static struct Lisp_Objfwd o_fwd; \
2726 defvar_lisp_nopro (&o_fwd, lname, &globals.f_ ## vname); \
2727 } while (false)
2728 #define DEFVAR_BOOL(lname, vname, doc) \
2729 do { \
2730 static struct Lisp_Boolfwd b_fwd; \
2731 defvar_bool (&b_fwd, lname, &globals.f_ ## vname); \
2732 } while (false)
2733 #define DEFVAR_INT(lname, vname, doc) \
2734 do { \
2735 static struct Lisp_Intfwd i_fwd; \
2736 defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
2737 } while (false)
2738
2739 #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \
2740 do { \
2741 static struct Lisp_Objfwd o_fwd; \
2742 defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \
2743 } while (false)
2744
2745 #define DEFVAR_KBOARD(lname, vname, doc) \
2746 do { \
2747 static struct Lisp_Kboard_Objfwd ko_fwd; \
2748 defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
2749 } while (false)
2750 \f
2751 /* Save and restore the instruction and environment pointers,
2752 without affecting the signal mask. */
2753
2754 #ifdef HAVE__SETJMP
2755 typedef jmp_buf sys_jmp_buf;
2756 # define sys_setjmp(j) _setjmp (j)
2757 # define sys_longjmp(j, v) _longjmp (j, v)
2758 #elif defined HAVE_SIGSETJMP
2759 typedef sigjmp_buf sys_jmp_buf;
2760 # define sys_setjmp(j) sigsetjmp (j, 0)
2761 # define sys_longjmp(j, v) siglongjmp (j, v)
2762 #else
2763 /* A platform that uses neither _longjmp nor siglongjmp; assume
2764 longjmp does not affect the sigmask. */
2765 typedef jmp_buf sys_jmp_buf;
2766 # define sys_setjmp(j) setjmp (j)
2767 # define sys_longjmp(j, v) longjmp (j, v)
2768 #endif
2769
2770 \f
2771 /* Elisp uses several stacks:
2772 - the C stack.
2773 - the bytecode stack: used internally by the bytecode interpreter.
2774 Allocated from the C stack.
2775 - The specpdl stack: keeps track of active unwind-protect and
2776 dynamic-let-bindings. Allocated from the `specpdl' array, a manually
2777 managed stack.
2778 - The handler stack: keeps track of active catch tags and condition-case
2779 handlers. Allocated in a manually managed stack implemented by a
2780 doubly-linked list allocated via xmalloc and never freed. */
2781
2782 /* Structure for recording Lisp call stack for backtrace purposes. */
2783
2784 /* The special binding stack holds the outer values of variables while
2785 they are bound by a function application or a let form, stores the
2786 code to be executed for unwind-protect forms.
2787
2788 NOTE: The specbinding union is defined here, because SPECPDL_INDEX is
2789 used all over the place, needs to be fast, and needs to know the size of
2790 union specbinding. But only eval.c should access it. */
2791
2792 enum specbind_tag {
2793 SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
2794 SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
2795 SPECPDL_UNWIND_INT, /* Likewise, on int. */
2796 SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
2797 SPECPDL_BACKTRACE, /* An element of the backtrace. */
2798 SPECPDL_LET, /* A plain and simple dynamic let-binding. */
2799 /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
2800 SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */
2801 SPECPDL_LET_DEFAULT /* A global binding for a localized var. */
2802 };
2803
2804 union specbinding
2805 {
2806 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2807 struct {
2808 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2809 void (*func) (Lisp_Object);
2810 Lisp_Object arg;
2811 } unwind;
2812 struct {
2813 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2814 void (*func) (void *);
2815 void *arg;
2816 } unwind_ptr;
2817 struct {
2818 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2819 void (*func) (int);
2820 int arg;
2821 } unwind_int;
2822 struct {
2823 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2824 void (*func) (void);
2825 } unwind_void;
2826 struct {
2827 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2828 /* `where' is not used in the case of SPECPDL_LET. */
2829 Lisp_Object symbol, old_value, where;
2830 } let;
2831 struct {
2832 ENUM_BF (specbind_tag) kind : CHAR_BIT;
2833 bool_bf debug_on_exit : 1;
2834 Lisp_Object function;
2835 Lisp_Object *args;
2836 ptrdiff_t nargs;
2837 } bt;
2838 };
2839
2840 extern union specbinding *specpdl;
2841 extern union specbinding *specpdl_ptr;
2842 extern ptrdiff_t specpdl_size;
2843
2844 INLINE ptrdiff_t
2845 SPECPDL_INDEX (void)
2846 {
2847 return specpdl_ptr - specpdl;
2848 }
2849
2850 /* This structure helps implement the `catch/throw' and `condition-case/signal'
2851 control structures. A struct handler contains all the information needed to
2852 restore the state of the interpreter after a non-local jump.
2853
2854 handler structures are chained together in a doubly linked list; the `next'
2855 member points to the next outer catchtag and the `nextfree' member points in
2856 the other direction to the next inner element (which is typically the next
2857 free element since we mostly use it on the deepest handler).
2858
2859 A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
2860 member is TAG, and then unbinds to it. The `val' member is used to
2861 hold VAL while the stack is unwound; `val' is returned as the value
2862 of the catch form.
2863
2864 All the other members are concerned with restoring the interpreter
2865 state.
2866
2867 Members are volatile if their values need to survive _longjmp when
2868 a 'struct handler' is a local variable. */
2869
2870 enum handlertype { CATCHER, CONDITION_CASE };
2871
2872 struct handler
2873 {
2874 enum handlertype type;
2875 Lisp_Object tag_or_ch;
2876 Lisp_Object val;
2877 struct handler *next;
2878 struct handler *nextfree;
2879
2880 /* The bytecode interpreter can have several handlers active at the same
2881 time, so when we longjmp to one of them, it needs to know which handler
2882 this was and what was the corresponding internal state. This is stored
2883 here, and when we longjmp we make sure that handlerlist points to the
2884 proper handler. */
2885 Lisp_Object *bytecode_top;
2886 int bytecode_dest;
2887
2888 /* Most global vars are reset to their value via the specpdl mechanism,
2889 but a few others are handled by storing their value here. */
2890 #if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */
2891 struct gcpro *gcpro;
2892 #endif
2893 sys_jmp_buf jmp;
2894 EMACS_INT lisp_eval_depth;
2895 ptrdiff_t pdlcount;
2896 int poll_suppress_count;
2897 int interrupt_input_blocked;
2898 struct byte_stack *byte_stack;
2899 };
2900
2901 /* Fill in the components of c, and put it on the list. */
2902 #define PUSH_HANDLER(c, tag_ch_val, handlertype) \
2903 if (handlerlist->nextfree) \
2904 (c) = handlerlist->nextfree; \
2905 else \
2906 { \
2907 (c) = xmalloc (sizeof (struct handler)); \
2908 (c)->nextfree = NULL; \
2909 handlerlist->nextfree = (c); \
2910 } \
2911 (c)->type = (handlertype); \
2912 (c)->tag_or_ch = (tag_ch_val); \
2913 (c)->val = Qnil; \
2914 (c)->next = handlerlist; \
2915 (c)->lisp_eval_depth = lisp_eval_depth; \
2916 (c)->pdlcount = SPECPDL_INDEX (); \
2917 (c)->poll_suppress_count = poll_suppress_count; \
2918 (c)->interrupt_input_blocked = interrupt_input_blocked;\
2919 (c)->gcpro = gcprolist; \
2920 (c)->byte_stack = byte_stack_list; \
2921 handlerlist = (c);
2922
2923
2924 extern Lisp_Object memory_signal_data;
2925
2926 /* An address near the bottom of the stack.
2927 Tells GC how to save a copy of the stack. */
2928 extern char *stack_bottom;
2929
2930 /* Check quit-flag and quit if it is non-nil.
2931 Typing C-g does not directly cause a quit; it only sets Vquit_flag.
2932 So the program needs to do QUIT at times when it is safe to quit.
2933 Every loop that might run for a long time or might not exit
2934 ought to do QUIT at least once, at a safe place.
2935 Unless that is impossible, of course.
2936 But it is very desirable to avoid creating loops where QUIT is impossible.
2937
2938 Exception: if you set immediate_quit to true,
2939 then the handler that responds to the C-g does the quit itself.
2940 This is a good thing to do around a loop that has no side effects
2941 and (in particular) cannot call arbitrary Lisp code.
2942
2943 If quit-flag is set to `kill-emacs' the SIGINT handler has received
2944 a request to exit Emacs when it is safe to do. */
2945
2946 extern void process_pending_signals (void);
2947 extern bool volatile pending_signals;
2948
2949 extern void process_quit_flag (void);
2950 #define QUIT \
2951 do { \
2952 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
2953 process_quit_flag (); \
2954 else if (pending_signals) \
2955 process_pending_signals (); \
2956 } while (false)
2957
2958
2959 /* True if ought to quit now. */
2960
2961 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
2962 \f
2963 extern Lisp_Object Vascii_downcase_table;
2964 extern Lisp_Object Vascii_canon_table;
2965 \f
2966 /* Structure for recording stack slots that need marking. */
2967
2968 /* This is a chain of structures, each of which points at a Lisp_Object
2969 variable whose value should be marked in garbage collection.
2970 Normally every link of the chain is an automatic variable of a function,
2971 and its `val' points to some argument or local variable of the function.
2972 On exit to the function, the chain is set back to the value it had on entry.
2973 This way, no link remains in the chain when the stack frame containing the
2974 link disappears.
2975
2976 Every function that can call Feval must protect in this fashion all
2977 Lisp_Object variables whose contents will be used again. */
2978
2979 extern struct gcpro *gcprolist;
2980
2981 struct gcpro
2982 {
2983 struct gcpro *next;
2984
2985 /* Address of first protected variable. */
2986 volatile Lisp_Object *var;
2987
2988 /* Number of consecutive protected variables. */
2989 ptrdiff_t nvars;
2990
2991 #ifdef DEBUG_GCPRO
2992 int level;
2993 #endif
2994 };
2995
2996 /* Values of GC_MARK_STACK during compilation:
2997
2998 0 Use GCPRO as before
2999 1 Do the real thing, make GCPROs and UNGCPRO no-ops.
3000 2 Mark the stack, and check that everything GCPRO'd is
3001 marked.
3002 3 Mark using GCPRO's, mark stack last, and count how many
3003 dead objects are kept alive.
3004
3005 Formerly, method 0 was used. Currently, method 1 is used unless
3006 otherwise specified by hand when building, e.g.,
3007 "make CPPFLAGS='-DGC_MARK_STACK=GC_USE_GCPROS_AS_BEFORE'".
3008 Methods 2 and 3 are present mainly to debug the transition from 0 to 1. */
3009
3010 #define GC_USE_GCPROS_AS_BEFORE 0
3011 #define GC_MAKE_GCPROS_NOOPS 1
3012 #define GC_MARK_STACK_CHECK_GCPROS 2
3013 #define GC_USE_GCPROS_CHECK_ZOMBIES 3
3014
3015 #ifndef GC_MARK_STACK
3016 #define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
3017 #endif
3018
3019 /* Whether we do the stack marking manually. */
3020 #define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
3021 || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
3022
3023
3024 #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
3025
3026 /* Do something silly with gcproN vars just so gcc shuts up. */
3027 /* You get warnings from MIPSPro... */
3028
3029 #define GCPRO1(varname) ((void) gcpro1)
3030 #define GCPRO2(varname1, varname2) ((void) gcpro2, (void) gcpro1)
3031 #define GCPRO3(varname1, varname2, varname3) \
3032 ((void) gcpro3, (void) gcpro2, (void) gcpro1)
3033 #define GCPRO4(varname1, varname2, varname3, varname4) \
3034 ((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
3035 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
3036 ((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
3037 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
3038 ((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, \
3039 (void) gcpro1)
3040 #define GCPRO7(a, b, c, d, e, f, g) (GCPRO6 (a, b, c, d, e, f), (void) gcpro7)
3041 #define UNGCPRO ((void) 0)
3042
3043 #else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
3044
3045 #ifndef DEBUG_GCPRO
3046
3047 #define GCPRO1(varname) \
3048 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
3049 gcprolist = &gcpro1; }
3050
3051 #define GCPRO2(varname1, varname2) \
3052 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3053 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3054 gcprolist = &gcpro2; }
3055
3056 #define GCPRO3(varname1, varname2, varname3) \
3057 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3058 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3059 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3060 gcprolist = &gcpro3; }
3061
3062 #define GCPRO4(varname1, varname2, varname3, varname4) \
3063 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3064 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3065 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3066 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3067 gcprolist = &gcpro4; }
3068
3069 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
3070 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3071 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3072 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3073 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3074 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
3075 gcprolist = &gcpro5; }
3076
3077 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
3078 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3079 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3080 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3081 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3082 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
3083 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
3084 gcprolist = &gcpro6; }
3085
3086 #define GCPRO7(a, b, c, d, e, f, g) \
3087 {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
3088 gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
3089 gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
3090 gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
3091 gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
3092 gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
3093 gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
3094 gcprolist = &gcpro7; }
3095
3096 #define UNGCPRO (gcprolist = gcpro1.next)
3097
3098 #else
3099
3100 extern int gcpro_level;
3101
3102 #define GCPRO1(varname) \
3103 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
3104 gcpro1.level = gcpro_level++; \
3105 gcprolist = &gcpro1; }
3106
3107 #define GCPRO2(varname1, varname2) \
3108 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3109 gcpro1.level = gcpro_level; \
3110 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3111 gcpro2.level = gcpro_level++; \
3112 gcprolist = &gcpro2; }
3113
3114 #define GCPRO3(varname1, varname2, varname3) \
3115 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3116 gcpro1.level = gcpro_level; \
3117 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3118 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3119 gcpro3.level = gcpro_level++; \
3120 gcprolist = &gcpro3; }
3121
3122 #define GCPRO4(varname1, varname2, varname3, varname4) \
3123 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3124 gcpro1.level = gcpro_level; \
3125 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3126 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3127 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3128 gcpro4.level = gcpro_level++; \
3129 gcprolist = &gcpro4; }
3130
3131 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
3132 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3133 gcpro1.level = gcpro_level; \
3134 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3135 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3136 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3137 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
3138 gcpro5.level = gcpro_level++; \
3139 gcprolist = &gcpro5; }
3140
3141 #define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
3142 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
3143 gcpro1.level = gcpro_level; \
3144 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
3145 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
3146 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
3147 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
3148 gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
3149 gcpro6.level = gcpro_level++; \
3150 gcprolist = &gcpro6; }
3151
3152 #define GCPRO7(a, b, c, d, e, f, g) \
3153 {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
3154 gcpro1.level = gcpro_level; \
3155 gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
3156 gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
3157 gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
3158 gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
3159 gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
3160 gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
3161 gcpro7.level = gcpro_level++; \
3162 gcprolist = &gcpro7; }
3163
3164 #define UNGCPRO \
3165 (--gcpro_level != gcpro1.level \
3166 ? emacs_abort () \
3167 : (void) (gcprolist = gcpro1.next))
3168
3169 #endif /* DEBUG_GCPRO */
3170 #endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
3171
3172
3173 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
3174 #define RETURN_UNGCPRO(expr) \
3175 do \
3176 { \
3177 Lisp_Object ret_ungc_val; \
3178 ret_ungc_val = (expr); \
3179 UNGCPRO; \
3180 return ret_ungc_val; \
3181 } \
3182 while (false)
3183
3184 /* Call staticpro (&var) to protect static variable `var'. */
3185
3186 void staticpro (Lisp_Object *);
3187 \f
3188 /* Declare a Lisp-callable function. The MAXARGS parameter has the same
3189 meaning as in the DEFUN macro, and is used to construct a prototype. */
3190 /* We can use the same trick as in the DEFUN macro to generate the
3191 appropriate prototype. */
3192 #define EXFUN(fnname, maxargs) \
3193 extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
3194
3195 #include "globals.h"
3196
3197 /* Forward declarations for prototypes. */
3198 struct window;
3199 struct frame;
3200
3201 /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
3202
3203 INLINE void
3204 vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
3205 {
3206 eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
3207 memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
3208 }
3209
3210 /* Functions to modify hash tables. */
3211
3212 INLINE void
3213 set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3214 {
3215 gc_aset (h->key_and_value, 2 * idx, val);
3216 }
3217
3218 INLINE void
3219 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
3220 {
3221 gc_aset (h->key_and_value, 2 * idx + 1, val);
3222 }
3223
3224 /* Use these functions to set Lisp_Object
3225 or pointer slots of struct Lisp_Symbol. */
3226
3227 INLINE void
3228 set_symbol_function (Lisp_Object sym, Lisp_Object function)
3229 {
3230 XSYMBOL (sym)->function = function;
3231 }
3232
3233 INLINE void
3234 set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
3235 {
3236 XSYMBOL (sym)->plist = plist;
3237 }
3238
3239 INLINE void
3240 set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
3241 {
3242 XSYMBOL (sym)->next = next;
3243 }
3244
3245 /* Buffer-local (also frame-local) variable access functions. */
3246
3247 INLINE int
3248 blv_found (struct Lisp_Buffer_Local_Value *blv)
3249 {
3250 eassert (blv->found == !EQ (blv->defcell, blv->valcell));
3251 return blv->found;
3252 }
3253
3254 /* Set overlay's property list. */
3255
3256 INLINE void
3257 set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
3258 {
3259 XOVERLAY (overlay)->plist = plist;
3260 }
3261
3262 /* Get text properties of S. */
3263
3264 INLINE INTERVAL
3265 string_intervals (Lisp_Object s)
3266 {
3267 return XSTRING (s)->intervals;
3268 }
3269
3270 /* Set text properties of S to I. */
3271
3272 INLINE void
3273 set_string_intervals (Lisp_Object s, INTERVAL i)
3274 {
3275 XSTRING (s)->intervals = i;
3276 }
3277
3278 /* Set a Lisp slot in TABLE to VAL. Most code should use this instead
3279 of setting slots directly. */
3280
3281 INLINE void
3282 set_char_table_defalt (Lisp_Object table, Lisp_Object val)
3283 {
3284 XCHAR_TABLE (table)->defalt = val;
3285 }
3286 INLINE void
3287 set_char_table_purpose (Lisp_Object table, Lisp_Object val)
3288 {
3289 XCHAR_TABLE (table)->purpose = val;
3290 }
3291
3292 /* Set different slots in (sub)character tables. */
3293
3294 INLINE void
3295 set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3296 {
3297 eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
3298 XCHAR_TABLE (table)->extras[idx] = val;
3299 }
3300
3301 INLINE void
3302 set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3303 {
3304 eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
3305 XCHAR_TABLE (table)->contents[idx] = val;
3306 }
3307
3308 INLINE void
3309 set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3310 {
3311 XSUB_CHAR_TABLE (table)->contents[idx] = val;
3312 }
3313
3314 /* Defined in data.c. */
3315 extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
3316 extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
3317 extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
3318 extern Lisp_Object Qvoid_variable, Qvoid_function;
3319 extern Lisp_Object Qinvalid_read_syntax;
3320 extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
3321 extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
3322 extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
3323 extern Lisp_Object Qtext_read_only;
3324 extern Lisp_Object Qinteractive_form;
3325 extern Lisp_Object Qcircular_list;
3326 extern Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
3327 extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
3328 extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
3329 extern Lisp_Object Qbuffer_or_string_p;
3330 extern Lisp_Object Qfboundp;
3331 extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
3332
3333 extern Lisp_Object Qcdr;
3334
3335 extern Lisp_Object Qrange_error, Qoverflow_error;
3336
3337 extern Lisp_Object Qfloatp;
3338 extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
3339
3340 extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
3341
3342 extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
3343
3344 EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
3345
3346 /* Defined in data.c. */
3347 extern Lisp_Object indirect_function (Lisp_Object);
3348 extern Lisp_Object find_symbol_value (Lisp_Object);
3349 enum Arith_Comparison {
3350 ARITH_EQUAL,
3351 ARITH_NOTEQUAL,
3352 ARITH_LESS,
3353 ARITH_GRTR,
3354 ARITH_LESS_OR_EQUAL,
3355 ARITH_GRTR_OR_EQUAL
3356 };
3357 extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
3358 enum Arith_Comparison comparison);
3359
3360 /* Convert the integer I to an Emacs representation, either the integer
3361 itself, or a cons of two or three integers, or if all else fails a float.
3362 I should not have side effects. */
3363 #define INTEGER_TO_CONS(i) \
3364 (! FIXNUM_OVERFLOW_P (i) \
3365 ? make_number (i) \
3366 : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \
3367 || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \
3368 && FIXNUM_OVERFLOW_P ((i) >> 16)) \
3369 ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
3370 : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \
3371 || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \
3372 && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
3373 ? Fcons (make_number ((i) >> 16 >> 24), \
3374 Fcons (make_number ((i) >> 16 & 0xffffff), \
3375 make_number ((i) & 0xffff))) \
3376 : make_float (i))
3377
3378 /* Convert the Emacs representation CONS back to an integer of type
3379 TYPE, storing the result the variable VAR. Signal an error if CONS
3380 is not a valid representation or is out of range for TYPE. */
3381 #define CONS_TO_INTEGER(cons, type, var) \
3382 (TYPE_SIGNED (type) \
3383 ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \
3384 : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type))))
3385 extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
3386 extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
3387
3388 extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
3389 extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
3390 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
3391 Lisp_Object);
3392 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
3393 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
3394 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
3395 extern void syms_of_data (void);
3396 extern void swap_in_global_binding (struct Lisp_Symbol *);
3397
3398 /* Defined in cmds.c */
3399 extern void syms_of_cmds (void);
3400 extern void keys_of_cmds (void);
3401
3402 /* Defined in coding.c. */
3403 extern Lisp_Object Qcharset;
3404 extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
3405 ptrdiff_t, bool, bool, Lisp_Object);
3406 extern void init_coding (void);
3407 extern void init_coding_once (void);
3408 extern void syms_of_coding (void);
3409
3410 /* Defined in character.c. */
3411 EXFUN (Fmax_char, 0) ATTRIBUTE_CONST;
3412 extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
3413 extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
3414 extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST;
3415 extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST;
3416 extern void syms_of_character (void);
3417
3418 /* Defined in charset.c. */
3419 extern void init_charset (void);
3420 extern void init_charset_once (void);
3421 extern void syms_of_charset (void);
3422 /* Structure forward declarations. */
3423 struct charset;
3424
3425 /* Defined in composite.c. */
3426 extern void syms_of_composite (void);
3427
3428 /* Defined in syntax.c. */
3429 extern void init_syntax_once (void);
3430 extern void syms_of_syntax (void);
3431
3432 /* Defined in fns.c. */
3433 extern Lisp_Object QCrehash_size, QCrehash_threshold;
3434 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
3435 EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
3436 extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
3437 extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
3438 extern void sweep_weak_hash_tables (void);
3439 extern Lisp_Object Qcursor_in_echo_area;
3440 extern Lisp_Object Qstring_lessp;
3441 extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
3442 EMACS_UINT hash_string (char const *, ptrdiff_t);
3443 EMACS_UINT sxhash (Lisp_Object, int);
3444 Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
3445 Lisp_Object, Lisp_Object);
3446 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
3447 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3448 EMACS_UINT);
3449 extern struct hash_table_test hashtest_eql, hashtest_equal;
3450
3451 extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
3452 ptrdiff_t, ptrdiff_t);
3453 extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
3454 extern Lisp_Object do_yes_or_no_p (Lisp_Object);
3455 extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
3456 extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
3457 extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
3458 extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
3459 extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
3460 extern void clear_string_char_byte_cache (void);
3461 extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
3462 extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
3463 extern Lisp_Object string_to_multibyte (Lisp_Object);
3464 extern Lisp_Object string_make_unibyte (Lisp_Object);
3465 extern void syms_of_fns (void);
3466
3467 /* Defined in floatfns.c. */
3468 extern double extract_float (Lisp_Object);
3469 extern void syms_of_floatfns (void);
3470 extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
3471
3472 /* Defined in fringe.c. */
3473 extern void syms_of_fringe (void);
3474 extern void init_fringe (void);
3475 #ifdef HAVE_WINDOW_SYSTEM
3476 extern void mark_fringe_data (void);
3477 extern void init_fringe_once (void);
3478 #endif /* HAVE_WINDOW_SYSTEM */
3479
3480 /* Defined in image.c. */
3481 extern Lisp_Object QCascent, QCmargin, QCrelief;
3482 extern Lisp_Object QCconversion;
3483 extern int x_bitmap_mask (struct frame *, ptrdiff_t);
3484 extern void reset_image_types (void);
3485 extern void syms_of_image (void);
3486
3487 /* Defined in insdel.c. */
3488 extern Lisp_Object Qinhibit_modification_hooks;
3489 extern void move_gap_both (ptrdiff_t, ptrdiff_t);
3490 extern _Noreturn void buffer_overflow (void);
3491 extern void make_gap (ptrdiff_t);
3492 extern void make_gap_1 (struct buffer *, ptrdiff_t);
3493 extern ptrdiff_t copy_text (const unsigned char *, unsigned char *,
3494 ptrdiff_t, bool, bool);
3495 extern int count_combining_before (const unsigned char *,
3496 ptrdiff_t, ptrdiff_t, ptrdiff_t);
3497 extern int count_combining_after (const unsigned char *,
3498 ptrdiff_t, ptrdiff_t, ptrdiff_t);
3499 extern void insert (const char *, ptrdiff_t);
3500 extern void insert_and_inherit (const char *, ptrdiff_t);
3501 extern void insert_1_both (const char *, ptrdiff_t, ptrdiff_t,
3502 bool, bool, bool);
3503 extern void insert_from_gap (ptrdiff_t, ptrdiff_t, bool text_at_gap_tail);
3504 extern void insert_from_string (Lisp_Object, ptrdiff_t, ptrdiff_t,
3505 ptrdiff_t, ptrdiff_t, bool);
3506 extern void insert_from_buffer (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
3507 extern void insert_char (int);
3508 extern void insert_string (const char *);
3509 extern void insert_before_markers (const char *, ptrdiff_t);
3510 extern void insert_before_markers_and_inherit (const char *, ptrdiff_t);
3511 extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
3512 ptrdiff_t, ptrdiff_t,
3513 ptrdiff_t, bool);
3514 extern void del_range (ptrdiff_t, ptrdiff_t);
3515 extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
3516 extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool);
3517 extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
3518 extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
3519 ptrdiff_t, ptrdiff_t, bool);
3520 extern void modify_text (ptrdiff_t, ptrdiff_t);
3521 extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
3522 extern void prepare_to_modify_buffer_1 (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
3523 extern void invalidate_buffer_caches (struct buffer *, ptrdiff_t, ptrdiff_t);
3524 extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
3525 extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3526 ptrdiff_t, ptrdiff_t);
3527 extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
3528 ptrdiff_t, ptrdiff_t);
3529 extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool);
3530 extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
3531 const char *, ptrdiff_t, ptrdiff_t, bool);
3532 extern void syms_of_insdel (void);
3533
3534 /* Defined in dispnew.c. */
3535 #if (defined PROFILING \
3536 && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
3537 _Noreturn void __executable_start (void);
3538 #endif
3539 extern Lisp_Object Vwindow_system;
3540 extern Lisp_Object sit_for (Lisp_Object, bool, int);
3541 extern void init_display (void);
3542 extern void syms_of_display (void);
3543
3544 /* Defined in xdisp.c. */
3545 extern Lisp_Object Qinhibit_point_motion_hooks;
3546 extern Lisp_Object Qinhibit_redisplay, Qdisplay;
3547 extern Lisp_Object Qmenu_bar_update_hook;
3548 extern Lisp_Object Qwindow_scroll_functions;
3549 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
3550 extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
3551 extern Lisp_Object Qspace, Qcenter, QCalign_to;
3552 extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
3553 extern Lisp_Object Qleft_margin, Qright_margin;
3554 extern Lisp_Object QCdata, QCfile;
3555 extern Lisp_Object QCmap;
3556 extern Lisp_Object Qrisky_local_variable;
3557 extern bool noninteractive_need_newline;
3558 extern Lisp_Object echo_area_buffer[2];
3559 extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
3560 extern void check_message_stack (void);
3561 extern void setup_echo_area_for_printing (int);
3562 extern bool push_message (void);
3563 extern void pop_message_unwind (void);
3564 extern Lisp_Object restore_message_unwind (Lisp_Object);
3565 extern void restore_message (void);
3566 extern Lisp_Object current_message (void);
3567 extern void clear_message (bool, bool);
3568 extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
3569 extern void message1 (const char *);
3570 extern void message1_nolog (const char *);
3571 extern void message3 (Lisp_Object);
3572 extern void message3_nolog (Lisp_Object);
3573 extern void message_dolog (const char *, ptrdiff_t, bool, bool);
3574 extern void message_with_string (const char *, Lisp_Object, int);
3575 extern void message_log_maybe_newline (void);
3576 extern void update_echo_area (void);
3577 extern void truncate_echo_area (ptrdiff_t);
3578 extern void redisplay (void);
3579 extern void redisplay_preserve_echo_area (int);
3580
3581 void set_frame_cursor_types (struct frame *, Lisp_Object);
3582 extern void syms_of_xdisp (void);
3583 extern void init_xdisp (void);
3584 extern Lisp_Object safe_eval (Lisp_Object);
3585 extern int pos_visible_p (struct window *, ptrdiff_t, int *,
3586 int *, int *, int *, int *, int *);
3587
3588 /* Defined in xsettings.c. */
3589 extern void syms_of_xsettings (void);
3590
3591 /* Defined in vm-limit.c. */
3592 extern void memory_warnings (void *, void (*warnfun) (const char *));
3593
3594 /* Defined in alloc.c. */
3595 extern void check_pure_size (void);
3596 extern void free_misc (Lisp_Object);
3597 extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
3598 extern void malloc_warning (const char *);
3599 extern _Noreturn void memory_full (size_t);
3600 extern _Noreturn void buffer_memory_full (ptrdiff_t);
3601 extern bool survives_gc_p (Lisp_Object);
3602 extern void mark_object (Lisp_Object);
3603 #if defined REL_ALLOC && !defined SYSTEM_MALLOC
3604 extern void refill_memory_reserve (void);
3605 #endif
3606 extern const char *pending_malloc_warning;
3607 extern Lisp_Object zero_vector;
3608 extern Lisp_Object *stack_base;
3609 extern EMACS_INT consing_since_gc;
3610 extern EMACS_INT gc_relative_threshold;
3611 extern EMACS_INT memory_full_cons_threshold;
3612 extern Lisp_Object list1 (Lisp_Object);
3613 extern Lisp_Object list2 (Lisp_Object, Lisp_Object);
3614 extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
3615 extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3616 extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
3617 Lisp_Object);
3618 enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
3619 extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
3620
3621 /* Build a frequently used 2/3/4-integer lists. */
3622
3623 INLINE Lisp_Object
3624 list2i (EMACS_INT x, EMACS_INT y)
3625 {
3626 return list2 (make_number (x), make_number (y));
3627 }
3628
3629 INLINE Lisp_Object
3630 list3i (EMACS_INT x, EMACS_INT y, EMACS_INT w)
3631 {
3632 return list3 (make_number (x), make_number (y), make_number (w));
3633 }
3634
3635 INLINE Lisp_Object
3636 list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h)
3637 {
3638 return list4 (make_number (x), make_number (y),
3639 make_number (w), make_number (h));
3640 }
3641
3642 extern Lisp_Object make_uninit_bool_vector (EMACS_INT);
3643 extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object);
3644 extern _Noreturn void string_overflow (void);
3645 extern Lisp_Object make_string (const char *, ptrdiff_t);
3646 extern Lisp_Object make_formatted_string (char *, const char *, ...)
3647 ATTRIBUTE_FORMAT_PRINTF (2, 3);
3648 extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
3649
3650 /* Make unibyte string from C string when the length isn't known. */
3651
3652 INLINE Lisp_Object
3653 build_unibyte_string (const char *str)
3654 {
3655 return make_unibyte_string (str, strlen (str));
3656 }
3657
3658 extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
3659 extern Lisp_Object make_event_array (ptrdiff_t, Lisp_Object *);
3660 extern Lisp_Object make_uninit_string (EMACS_INT);
3661 extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
3662 extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
3663 extern Lisp_Object make_specified_string (const char *,
3664 ptrdiff_t, ptrdiff_t, bool);
3665 extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
3666 extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
3667
3668 /* Make a string allocated in pure space, use STR as string data. */
3669
3670 INLINE Lisp_Object
3671 build_pure_c_string (const char *str)
3672 {
3673 return make_pure_c_string (str, strlen (str));
3674 }
3675
3676 /* Make a string from the data at STR, treating it as multibyte if the
3677 data warrants. */
3678
3679 INLINE Lisp_Object
3680 build_string (const char *str)
3681 {
3682 return make_string (str, strlen (str));
3683 }
3684
3685 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
3686 extern void make_byte_code (struct Lisp_Vector *);
3687 extern Lisp_Object Qautomatic_gc;
3688 extern Lisp_Object Qchar_table_extra_slots;
3689 extern struct Lisp_Vector *allocate_vector (EMACS_INT);
3690
3691 /* Make an uninitialized vector for SIZE objects. NOTE: you must
3692 be sure that GC cannot happen until the vector is completely
3693 initialized. E.g. the following code is likely to crash:
3694
3695 v = make_uninit_vector (3);
3696 ASET (v, 0, obj0);
3697 ASET (v, 1, Ffunction_can_gc ());
3698 ASET (v, 2, obj1); */
3699
3700 INLINE Lisp_Object
3701 make_uninit_vector (ptrdiff_t size)
3702 {
3703 Lisp_Object v;
3704 struct Lisp_Vector *p;
3705
3706 p = allocate_vector (size);
3707 XSETVECTOR (v, p);
3708 return v;
3709 }
3710
3711 extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type);
3712 #define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
3713 ((typ*) \
3714 allocate_pseudovector \
3715 (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag))
3716 extern struct Lisp_Hash_Table *allocate_hash_table (void);
3717 extern struct window *allocate_window (void);
3718 extern struct frame *allocate_frame (void);
3719 extern struct Lisp_Process *allocate_process (void);
3720 extern struct terminal *allocate_terminal (void);
3721 extern bool gc_in_progress;
3722 extern bool abort_on_gc;
3723 extern Lisp_Object make_float (double);
3724 extern void display_malloc_warning (void);
3725 extern ptrdiff_t inhibit_garbage_collection (void);
3726 extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
3727 extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
3728 Lisp_Object, Lisp_Object);
3729 extern Lisp_Object make_save_ptr (void *);
3730 extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
3731 extern Lisp_Object make_save_ptr_ptr (void *, void *);
3732 extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
3733 Lisp_Object);
3734 extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
3735 extern void free_save_value (Lisp_Object);
3736 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
3737 extern void free_marker (Lisp_Object);
3738 extern void free_cons (struct Lisp_Cons *);
3739 extern void init_alloc_once (void);
3740 extern void init_alloc (void);
3741 extern void syms_of_alloc (void);
3742 extern struct buffer * allocate_buffer (void);
3743 extern int valid_lisp_object_p (Lisp_Object);
3744 #ifdef GC_CHECK_CONS_LIST
3745 extern void check_cons_list (void);
3746 #else
3747 INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
3748 #endif
3749
3750 #ifdef REL_ALLOC
3751 /* Defined in ralloc.c. */
3752 extern void *r_alloc (void **, size_t);
3753 extern void r_alloc_free (void **);
3754 extern void *r_re_alloc (void **, size_t);
3755 extern void r_alloc_reset_variable (void **, void **);
3756 extern void r_alloc_inhibit_buffer_relocation (int);
3757 #endif
3758
3759 /* Defined in chartab.c. */
3760 extern Lisp_Object copy_char_table (Lisp_Object);
3761 extern Lisp_Object char_table_ref (Lisp_Object, int);
3762 extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
3763 int *, int *);
3764 extern void char_table_set (Lisp_Object, int, Lisp_Object);
3765 extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
3766 extern int char_table_translate (Lisp_Object, int);
3767 extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
3768 Lisp_Object),
3769 Lisp_Object, Lisp_Object, Lisp_Object);
3770 extern void map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
3771 Lisp_Object, Lisp_Object,
3772 Lisp_Object, struct charset *,
3773 unsigned, unsigned);
3774 extern Lisp_Object uniprop_table (Lisp_Object);
3775 extern void syms_of_chartab (void);
3776
3777 /* Defined in print.c. */
3778 extern Lisp_Object Vprin1_to_string_buffer;
3779 extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
3780 extern Lisp_Object Qstandard_output;
3781 extern Lisp_Object Qexternal_debugging_output;
3782 extern void temp_output_buffer_setup (const char *);
3783 extern int print_level;
3784 extern Lisp_Object Qprint_escape_newlines;
3785 extern void write_string (const char *, int);
3786 extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
3787 Lisp_Object);
3788 extern Lisp_Object internal_with_output_to_temp_buffer
3789 (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
3790 enum FLOAT_TO_STRING_BUFSIZE { FLOAT_TO_STRING_BUFSIZE = 350 };
3791 extern int float_to_string (char *, double);
3792 extern void init_print_once (void);
3793 extern void syms_of_print (void);
3794
3795 /* Defined in doprnt.c. */
3796 extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
3797 va_list);
3798 extern ptrdiff_t esprintf (char *, char const *, ...)
3799 ATTRIBUTE_FORMAT_PRINTF (2, 3);
3800 extern ptrdiff_t exprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
3801 char const *, ...)
3802 ATTRIBUTE_FORMAT_PRINTF (5, 6);
3803 extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
3804 char const *, va_list)
3805 ATTRIBUTE_FORMAT_PRINTF (5, 0);
3806
3807 /* Defined in lread.c. */
3808 extern Lisp_Object Qvariable_documentation, Qstandard_input;
3809 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
3810 extern Lisp_Object Qlexical_binding;
3811 extern Lisp_Object check_obarray (Lisp_Object);
3812 extern Lisp_Object intern_1 (const char *, ptrdiff_t);
3813 extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
3814 extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
3815 INLINE void
3816 LOADHIST_ATTACH (Lisp_Object x)
3817 {
3818 if (initialized)
3819 Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
3820 }
3821 extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
3822 Lisp_Object *, Lisp_Object, bool);
3823 extern Lisp_Object string_to_number (char const *, int, bool);
3824 extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
3825 Lisp_Object);
3826 extern void dir_warning (const char *, Lisp_Object);
3827 extern void init_obarray (void);
3828 extern void init_lread (void);
3829 extern void syms_of_lread (void);
3830
3831 INLINE Lisp_Object
3832 intern (const char *str)
3833 {
3834 return intern_1 (str, strlen (str));
3835 }
3836
3837 INLINE Lisp_Object
3838 intern_c_string (const char *str)
3839 {
3840 return intern_c_string_1 (str, strlen (str));
3841 }
3842
3843 /* Defined in eval.c. */
3844 extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
3845 extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
3846 extern Lisp_Object Qand_rest;
3847 extern Lisp_Object Vautoload_queue;
3848 extern Lisp_Object Vsignaling_function;
3849 extern Lisp_Object inhibit_lisp_code;
3850 extern struct handler *handlerlist;
3851
3852 /* To run a normal hook, use the appropriate function from the list below.
3853 The calling convention:
3854
3855 if (!NILP (Vrun_hooks))
3856 call1 (Vrun_hooks, Qmy_funny_hook);
3857
3858 should no longer be used. */
3859 extern Lisp_Object Vrun_hooks;
3860 extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
3861 extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
3862 Lisp_Object (*funcall)
3863 (ptrdiff_t nargs, Lisp_Object *args));
3864 extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
3865 extern _Noreturn void xsignal0 (Lisp_Object);
3866 extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
3867 extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
3868 extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
3869 Lisp_Object);
3870 extern _Noreturn void signal_error (const char *, Lisp_Object);
3871 extern Lisp_Object eval_sub (Lisp_Object form);
3872 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
3873 extern Lisp_Object call0 (Lisp_Object);
3874 extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
3875 extern Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object);
3876 extern Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3877 extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3878 extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3879 extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3880 extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
3881 extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
3882 extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
3883 extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
3884 extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
3885 extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
3886 extern Lisp_Object internal_condition_case_n
3887 (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
3888 Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
3889 extern void specbind (Lisp_Object, Lisp_Object);
3890 extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
3891 extern void record_unwind_protect_ptr (void (*) (void *), void *);
3892 extern void record_unwind_protect_int (void (*) (int), int);
3893 extern void record_unwind_protect_void (void (*) (void));
3894 extern void record_unwind_protect_nothing (void);
3895 extern void clear_unwind_protect (ptrdiff_t);
3896 extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
3897 extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
3898 extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
3899 extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
3900 extern _Noreturn void verror (const char *, va_list)
3901 ATTRIBUTE_FORMAT_PRINTF (1, 0);
3902 extern void un_autoload (Lisp_Object);
3903 extern Lisp_Object call_debugger (Lisp_Object arg);
3904 extern void init_eval_once (void);
3905 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
3906 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
3907 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
3908 extern void init_eval (void);
3909 extern void syms_of_eval (void);
3910 extern void unwind_body (Lisp_Object);
3911 extern void record_in_backtrace (Lisp_Object function,
3912 Lisp_Object *args, ptrdiff_t nargs);
3913 extern void mark_specpdl (void);
3914 extern void get_backtrace (Lisp_Object array);
3915 Lisp_Object backtrace_top_function (void);
3916 extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
3917 extern bool let_shadows_global_binding_p (Lisp_Object symbol);
3918
3919
3920 /* Defined in editfns.c. */
3921 extern Lisp_Object Qfield;
3922 extern void insert1 (Lisp_Object);
3923 extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
3924 extern Lisp_Object save_excursion_save (void);
3925 extern Lisp_Object save_restriction_save (void);
3926 extern void save_excursion_restore (Lisp_Object);
3927 extern void save_restriction_restore (Lisp_Object);
3928 extern _Noreturn void time_overflow (void);
3929 extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
3930 extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3931 ptrdiff_t, bool);
3932 extern void init_editfns (void);
3933 extern void syms_of_editfns (void);
3934 extern void set_time_zone_rule (const char *);
3935
3936 /* Defined in buffer.c. */
3937 extern bool mouse_face_overlay_overlaps (Lisp_Object);
3938 extern _Noreturn void nsberror (Lisp_Object);
3939 extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
3940 extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
3941 extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
3942 extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
3943 Lisp_Object, Lisp_Object, Lisp_Object);
3944 extern bool overlay_touches_p (ptrdiff_t);
3945 extern Lisp_Object other_buffer_safely (Lisp_Object);
3946 extern Lisp_Object get_truename_buffer (Lisp_Object);
3947 extern void init_buffer_once (void);
3948 extern void init_buffer (void);
3949 extern void syms_of_buffer (void);
3950 extern void keys_of_buffer (void);
3951
3952 /* Defined in marker.c. */
3953
3954 extern ptrdiff_t marker_position (Lisp_Object);
3955 extern ptrdiff_t marker_byte_position (Lisp_Object);
3956 extern void clear_charpos_cache (struct buffer *);
3957 extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
3958 extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
3959 extern void unchain_marker (struct Lisp_Marker *marker);
3960 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
3961 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
3962 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
3963 ptrdiff_t, ptrdiff_t);
3964 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
3965 extern void syms_of_marker (void);
3966
3967 /* Defined in fileio.c. */
3968
3969 extern Lisp_Object Qfile_error;
3970 extern Lisp_Object Qfile_notify_error;
3971 extern Lisp_Object Qfile_exists_p;
3972 extern Lisp_Object Qfile_directory_p;
3973 extern Lisp_Object Qinsert_file_contents;
3974 extern Lisp_Object Qfile_name_history;
3975 extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
3976 extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
3977 Lisp_Object, Lisp_Object, Lisp_Object,
3978 Lisp_Object, int);
3979 EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
3980 extern void close_file_unwind (int);
3981 extern void fclose_unwind (void *);
3982 extern void restore_point_unwind (Lisp_Object);
3983 extern _Noreturn void report_file_errno (const char *, Lisp_Object, int);
3984 extern _Noreturn void report_file_error (const char *, Lisp_Object);
3985 extern bool internal_delete_file (Lisp_Object);
3986 extern Lisp_Object emacs_readlinkat (int, const char *);
3987 extern bool file_directory_p (const char *);
3988 extern bool file_accessible_directory_p (const char *);
3989 extern void init_fileio (void);
3990 extern void syms_of_fileio (void);
3991 extern Lisp_Object make_temp_name (Lisp_Object, bool);
3992 extern Lisp_Object Qdelete_file;
3993
3994 /* Defined in search.c. */
3995 extern void shrink_regexp_cache (void);
3996 extern void restore_search_regs (void);
3997 extern void record_unwind_save_match_data (void);
3998 struct re_registers;
3999 extern struct re_pattern_buffer *compile_pattern (Lisp_Object,
4000 struct re_registers *,
4001 Lisp_Object, bool, bool);
4002 extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object);
4003 extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *,
4004 ptrdiff_t);
4005 extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
4006 extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t,
4007 ptrdiff_t, ptrdiff_t, Lisp_Object);
4008 extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
4009 ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
4010 extern ptrdiff_t scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
4011 ptrdiff_t, bool);
4012 extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t,
4013 ptrdiff_t, ptrdiff_t *);
4014 extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t,
4015 ptrdiff_t, ptrdiff_t *);
4016 extern void syms_of_search (void);
4017 extern void clear_regexp_cache (void);
4018
4019 /* Defined in minibuf.c. */
4020
4021 extern Lisp_Object Qcompletion_ignore_case;
4022 extern Lisp_Object Vminibuffer_list;
4023 extern Lisp_Object last_minibuf_string;
4024 extern Lisp_Object get_minibuffer (EMACS_INT);
4025 extern void init_minibuf_once (void);
4026 extern void syms_of_minibuf (void);
4027
4028 /* Defined in callint.c. */
4029
4030 extern Lisp_Object Qminus, Qplus;
4031 extern Lisp_Object Qwhen;
4032 extern Lisp_Object Qmouse_leave_buffer_hook;
4033 extern void syms_of_callint (void);
4034
4035 /* Defined in casefiddle.c. */
4036
4037 extern Lisp_Object Qidentity;
4038 extern void syms_of_casefiddle (void);
4039 extern void keys_of_casefiddle (void);
4040
4041 /* Defined in casetab.c. */
4042
4043 extern void init_casetab_once (void);
4044 extern void syms_of_casetab (void);
4045
4046 /* Defined in keyboard.c. */
4047
4048 extern Lisp_Object echo_message_buffer;
4049 extern struct kboard *echo_kboard;
4050 extern void cancel_echoing (void);
4051 extern Lisp_Object Qdisabled, QCfilter;
4052 extern Lisp_Object Qup, Qdown, Qbottom;
4053 extern Lisp_Object Qtop;
4054 extern Lisp_Object last_undo_boundary;
4055 extern bool input_pending;
4056 extern Lisp_Object menu_bar_items (Lisp_Object);
4057 extern Lisp_Object tool_bar_items (Lisp_Object, int *);
4058 extern void discard_mouse_events (void);
4059 #ifdef USABLE_SIGIO
4060 void handle_input_available_signal (int);
4061 #endif
4062 extern Lisp_Object pending_funcalls;
4063 extern bool detect_input_pending (void);
4064 extern bool detect_input_pending_ignore_squeezables (void);
4065 extern bool detect_input_pending_run_timers (bool);
4066 extern void safe_run_hooks (Lisp_Object);
4067 extern void cmd_error_internal (Lisp_Object, const char *);
4068 extern Lisp_Object command_loop_1 (void);
4069 extern Lisp_Object read_menu_command (void);
4070 extern Lisp_Object recursive_edit_1 (void);
4071 extern void record_auto_save (void);
4072 extern void force_auto_save_soon (void);
4073 extern void init_keyboard (void);
4074 extern void syms_of_keyboard (void);
4075 extern void keys_of_keyboard (void);
4076
4077 /* Defined in indent.c. */
4078 extern ptrdiff_t current_column (void);
4079 extern void invalidate_current_column (void);
4080 extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT);
4081 extern void syms_of_indent (void);
4082
4083 /* Defined in frame.c. */
4084 extern Lisp_Object Qonly, Qnone;
4085 extern Lisp_Object Qvisible;
4086 extern void set_frame_param (struct frame *, Lisp_Object, Lisp_Object);
4087 extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
4088 extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
4089 extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
4090 #if HAVE_NS || HAVE_NTGUI
4091 extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
4092 #endif
4093 extern void frames_discard_buffer (Lisp_Object);
4094 extern void syms_of_frame (void);
4095
4096 /* Defined in emacs.c. */
4097 extern char **initial_argv;
4098 extern int initial_argc;
4099 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
4100 extern bool display_arg;
4101 #endif
4102 extern Lisp_Object decode_env_path (const char *, const char *, bool);
4103 extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
4104 extern Lisp_Object Qfile_name_handler_alist;
4105 extern _Noreturn void terminate_due_to_signal (int, int);
4106 extern Lisp_Object Qkill_emacs;
4107 #ifdef WINDOWSNT
4108 extern Lisp_Object Vlibrary_cache;
4109 #endif
4110 #if HAVE_SETLOCALE
4111 void fixup_locale (void);
4112 void synchronize_system_messages_locale (void);
4113 void synchronize_system_time_locale (void);
4114 #else
4115 INLINE void fixup_locale (void) {}
4116 INLINE void synchronize_system_messages_locale (void) {}
4117 INLINE void synchronize_system_time_locale (void) {}
4118 #endif
4119 extern void shut_down_emacs (int, Lisp_Object);
4120
4121 /* True means don't do interactive redisplay and don't change tty modes. */
4122 extern bool noninteractive;
4123
4124 /* True means remove site-lisp directories from load-path. */
4125 extern bool no_site_lisp;
4126
4127 /* Pipe used to send exit notification to the daemon parent at
4128 startup. */
4129 extern int daemon_pipe[2];
4130 #define IS_DAEMON (daemon_pipe[1] != 0)
4131
4132 /* True if handling a fatal error already. */
4133 extern bool fatal_error_in_progress;
4134
4135 /* True means don't do use window-system-specific display code. */
4136 extern bool inhibit_window_system;
4137 /* True means that a filter or a sentinel is running. */
4138 extern bool running_asynch_code;
4139
4140 /* Defined in process.c. */
4141 extern Lisp_Object QCtype, Qlocal;
4142 extern Lisp_Object Qprocessp;
4143 extern void kill_buffer_processes (Lisp_Object);
4144 extern bool wait_reading_process_output (intmax_t, int, int, bool,
4145 Lisp_Object,
4146 struct Lisp_Process *,
4147 int);
4148 /* Max value for the first argument of wait_reading_process_output. */
4149 #if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5)
4150 /* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3.
4151 The bug merely causes a bogus warning, but the warning is annoying. */
4152 # define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
4153 #else
4154 # define WAIT_READING_MAX INTMAX_MAX
4155 #endif
4156 extern void add_keyboard_wait_descriptor (int);
4157 extern void delete_keyboard_wait_descriptor (int);
4158 #ifdef HAVE_GPM
4159 extern void add_gpm_wait_descriptor (int);
4160 extern void delete_gpm_wait_descriptor (int);
4161 #endif
4162 extern void init_process_emacs (void);
4163 extern void syms_of_process (void);
4164 extern void setup_process_coding_systems (Lisp_Object);
4165
4166 /* Defined in callproc.c. */
4167 #ifndef DOS_NT
4168 _Noreturn
4169 #endif
4170 extern int child_setup (int, int, int, char **, bool, Lisp_Object);
4171 extern void init_callproc_1 (void);
4172 extern void init_callproc (void);
4173 extern void set_initial_environment (void);
4174 extern void syms_of_callproc (void);
4175
4176 /* Defined in doc.c. */
4177 extern Lisp_Object Qfunction_documentation;
4178 extern Lisp_Object read_doc_string (Lisp_Object);
4179 extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
4180 extern void syms_of_doc (void);
4181 extern int read_bytecode_char (bool);
4182
4183 /* Defined in bytecode.c. */
4184 extern void syms_of_bytecode (void);
4185 extern struct byte_stack *byte_stack_list;
4186 #if BYTE_MARK_STACK
4187 extern void mark_byte_stack (void);
4188 #endif
4189 extern void unmark_byte_stack (void);
4190 extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
4191 Lisp_Object, ptrdiff_t, Lisp_Object *);
4192
4193 /* Defined in macros.c. */
4194 extern void init_macros (void);
4195 extern void syms_of_macros (void);
4196
4197 /* Defined in undo.c. */
4198 extern Lisp_Object Qapply;
4199 extern Lisp_Object Qinhibit_read_only;
4200 extern void truncate_undo_list (struct buffer *);
4201 extern void record_marker_adjustment (Lisp_Object, ptrdiff_t);
4202 extern void record_insert (ptrdiff_t, ptrdiff_t);
4203 extern void record_delete (ptrdiff_t, Lisp_Object);
4204 extern void record_first_change (void);
4205 extern void record_change (ptrdiff_t, ptrdiff_t);
4206 extern void record_property_change (ptrdiff_t, ptrdiff_t,
4207 Lisp_Object, Lisp_Object,
4208 Lisp_Object);
4209 extern void syms_of_undo (void);
4210 /* Defined in textprop.c. */
4211 extern Lisp_Object Qfont, Qmouse_face;
4212 extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
4213 extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
4214 extern Lisp_Object Qminibuffer_prompt;
4215
4216 extern void report_interval_modification (Lisp_Object, Lisp_Object);
4217
4218 /* Defined in menu.c. */
4219 extern void syms_of_menu (void);
4220
4221 /* Defined in xmenu.c. */
4222 extern void syms_of_xmenu (void);
4223
4224 /* Defined in termchar.h. */
4225 struct tty_display_info;
4226
4227 /* Defined in termhooks.h. */
4228 struct terminal;
4229
4230 /* Defined in sysdep.c. */
4231 #ifndef HAVE_GET_CURRENT_DIR_NAME
4232 extern char *get_current_dir_name (void);
4233 #endif
4234 extern void stuff_char (char c);
4235 extern void init_foreground_group (void);
4236 extern void init_sigio (int);
4237 extern void sys_subshell (void);
4238 extern void sys_suspend (void);
4239 extern void discard_tty_input (void);
4240 extern void block_tty_out_signal (void);
4241 extern void unblock_tty_out_signal (void);
4242 extern void init_sys_modes (struct tty_display_info *);
4243 extern void reset_sys_modes (struct tty_display_info *);
4244 extern void init_all_sys_modes (void);
4245 extern void reset_all_sys_modes (void);
4246 extern void child_setup_tty (int);
4247 extern void setup_pty (int);
4248 extern int set_window_size (int, int, int);
4249 extern EMACS_INT get_random (void);
4250 extern void seed_random (void *, ptrdiff_t);
4251 extern void init_random (void);
4252 extern void emacs_backtrace (int);
4253 extern _Noreturn void emacs_abort (void) NO_INLINE;
4254 extern int emacs_open (const char *, int, int);
4255 extern int emacs_pipe (int[2]);
4256 extern int emacs_close (int);
4257 extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
4258 extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
4259 extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
4260 extern void emacs_perror (char const *);
4261
4262 extern void unlock_all_files (void);
4263 extern void lock_file (Lisp_Object);
4264 extern void unlock_file (Lisp_Object);
4265 extern void unlock_buffer (struct buffer *);
4266 extern void syms_of_filelock (void);
4267
4268 /* Defined in sound.c. */
4269 extern void syms_of_sound (void);
4270
4271 /* Defined in category.c. */
4272 extern void init_category_once (void);
4273 extern Lisp_Object char_category_set (int);
4274 extern void syms_of_category (void);
4275
4276 /* Defined in ccl.c. */
4277 extern void syms_of_ccl (void);
4278
4279 /* Defined in dired.c. */
4280 extern void syms_of_dired (void);
4281 extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
4282 Lisp_Object, Lisp_Object,
4283 bool, Lisp_Object);
4284
4285 /* Defined in term.c. */
4286 extern int *char_ins_del_vector;
4287 extern void syms_of_term (void);
4288 extern _Noreturn void fatal (const char *msgid, ...)
4289 ATTRIBUTE_FORMAT_PRINTF (1, 2);
4290
4291 /* Defined in terminal.c. */
4292 extern void syms_of_terminal (void);
4293
4294 /* Defined in font.c. */
4295 extern void syms_of_font (void);
4296 extern void init_font (void);
4297
4298 #ifdef HAVE_WINDOW_SYSTEM
4299 /* Defined in fontset.c. */
4300 extern void syms_of_fontset (void);
4301
4302 /* Defined in xfns.c, w32fns.c, or macfns.c. */
4303 extern Lisp_Object Qfont_param;
4304 #endif
4305
4306 /* Defined in gfilenotify.c */
4307 #ifdef HAVE_GFILENOTIFY
4308 extern void globals_of_gfilenotify (void);
4309 extern void syms_of_gfilenotify (void);
4310 #endif
4311
4312 /* Defined in inotify.c */
4313 #ifdef HAVE_INOTIFY
4314 extern void syms_of_inotify (void);
4315 #endif
4316
4317 #ifdef HAVE_W32NOTIFY
4318 /* Defined on w32notify.c. */
4319 extern void syms_of_w32notify (void);
4320 #endif
4321
4322 /* Defined in xfaces.c. */
4323 extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
4324 extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
4325 extern Lisp_Object Qmode_line_inactive;
4326 extern Lisp_Object Qface;
4327 extern Lisp_Object Qnormal;
4328 extern Lisp_Object QCfamily, QCweight, QCslant;
4329 extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
4330 extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
4331 extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
4332 extern Lisp_Object Qoblique, Qitalic;
4333 extern Lisp_Object Vface_alternative_font_family_alist;
4334 extern Lisp_Object Vface_alternative_font_registry_alist;
4335 extern void syms_of_xfaces (void);
4336
4337 #ifdef HAVE_X_WINDOWS
4338 /* Defined in xfns.c. */
4339 extern void syms_of_xfns (void);
4340
4341 /* Defined in xsmfns.c. */
4342 extern void syms_of_xsmfns (void);
4343
4344 /* Defined in xselect.c. */
4345 extern void syms_of_xselect (void);
4346
4347 /* Defined in xterm.c. */
4348 extern void syms_of_xterm (void);
4349 #endif /* HAVE_X_WINDOWS */
4350
4351 #ifdef HAVE_WINDOW_SYSTEM
4352 /* Defined in xterm.c, nsterm.m, w32term.c. */
4353 extern char *x_get_keysym_name (int);
4354 #endif /* HAVE_WINDOW_SYSTEM */
4355
4356 #ifdef HAVE_LIBXML2
4357 /* Defined in xml.c. */
4358 extern void syms_of_xml (void);
4359 extern void xml_cleanup_parser (void);
4360 #endif
4361
4362 #ifdef HAVE_ZLIB
4363 /* Defined in decompress.c. */
4364 extern void syms_of_decompress (void);
4365 #endif
4366
4367 #ifdef HAVE_DBUS
4368 /* Defined in dbusbind.c. */
4369 void syms_of_dbusbind (void);
4370 #endif
4371
4372
4373 /* Defined in profiler.c. */
4374 extern bool profiler_memory_running;
4375 extern void malloc_probe (size_t);
4376 extern void syms_of_profiler (void);
4377
4378
4379 #ifdef DOS_NT
4380 /* Defined in msdos.c, w32.c. */
4381 extern char *emacs_root_dir (void);
4382 #endif /* DOS_NT */
4383 \f
4384 /* True means Emacs has already been initialized.
4385 Used during startup to detect startup of dumped Emacs. */
4386 extern bool initialized;
4387
4388 /* True means ^G can quit instantly. */
4389 extern bool immediate_quit;
4390
4391 extern void *xmalloc (size_t);
4392 extern void *xzalloc (size_t);
4393 extern void *xrealloc (void *, size_t);
4394 extern void xfree (void *);
4395 extern void *xnmalloc (ptrdiff_t, ptrdiff_t);
4396 extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t);
4397 extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
4398
4399 extern char *xstrdup (const char *);
4400 extern char *xlispstrdup (Lisp_Object);
4401 extern void dupstring (char **, char const *);
4402 extern void xputenv (const char *);
4403
4404 extern char *egetenv (const char *);
4405
4406 /* Copy Lisp string to temporary (allocated on stack) C string. */
4407
4408 #define xlispstrdupa(string) \
4409 memcpy (alloca (SBYTES (string) + 1), \
4410 SSDATA (string), SBYTES (string) + 1)
4411
4412 /* Set up the name of the machine we're running on. */
4413 extern void init_system_name (void);
4414
4415 /* Return the absolute value of X. X should be a signed integer
4416 expression without side effects, and X's absolute value should not
4417 exceed the maximum for its promoted type. This is called 'eabs'
4418 because 'abs' is reserved by the C standard. */
4419 #define eabs(x) ((x) < 0 ? -(x) : (x))
4420
4421 /* Return a fixnum or float, depending on whether VAL fits in a Lisp
4422 fixnum. */
4423
4424 #define make_fixnum_or_float(val) \
4425 (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))
4426
4427 /* SAFE_ALLOCA normally allocates memory on the stack, but if size is
4428 larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
4429
4430 enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
4431
4432 extern void *record_xmalloc (size_t);
4433
4434 #define USE_SAFE_ALLOCA \
4435 ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
4436
4437 /* SAFE_ALLOCA allocates a simple buffer. */
4438
4439 #define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
4440 ? alloca (size) \
4441 : (sa_must_free = true, record_xmalloc (size)))
4442
4443 /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
4444 NITEMS items, each of the same type as *BUF. MULTIPLIER must
4445 positive. The code is tuned for MULTIPLIER being a constant. */
4446
4447 #define SAFE_NALLOCA(buf, multiplier, nitems) \
4448 do { \
4449 if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \
4450 (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \
4451 else \
4452 { \
4453 (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
4454 sa_must_free = true; \
4455 record_unwind_protect_ptr (xfree, buf); \
4456 } \
4457 } while (false)
4458
4459 /* SAFE_FREE frees xmalloced memory and enables GC as needed. */
4460
4461 #define SAFE_FREE() \
4462 do { \
4463 if (sa_must_free) { \
4464 sa_must_free = false; \
4465 unbind_to (sa_count, Qnil); \
4466 } \
4467 } while (false)
4468
4469
4470 /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
4471
4472 #define SAFE_ALLOCA_LISP(buf, nelt) \
4473 do { \
4474 if ((nelt) < MAX_ALLOCA / word_size) \
4475 (buf) = alloca ((nelt) * word_size); \
4476 else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
4477 { \
4478 Lisp_Object arg_; \
4479 (buf) = xmalloc ((nelt) * word_size); \
4480 arg_ = make_save_memory (buf, nelt); \
4481 sa_must_free = true; \
4482 record_unwind_protect (free_save_value, arg_); \
4483 } \
4484 else \
4485 memory_full (SIZE_MAX); \
4486 } while (false)
4487
4488 /* Loop over all tails of a list, checking for cycles.
4489 FIXME: Make tortoise and n internal declarations.
4490 FIXME: Unroll the loop body so we don't need `n'. */
4491 #define FOR_EACH_TAIL(hare, list, tortoise, n) \
4492 for ((tortoise) = (hare) = (list), (n) = true; \
4493 CONSP (hare); \
4494 (hare = XCDR (hare), (n) = !(n), \
4495 ((n) \
4496 ? (EQ (hare, tortoise) \
4497 ? xsignal1 (Qcircular_list, list) \
4498 : (void) 0) \
4499 /* Move tortoise before the next iteration, in case */ \
4500 /* the next iteration does an Fsetcdr. */ \
4501 : (void) ((tortoise) = XCDR (tortoise)))))
4502
4503 /* Do a `for' loop over alist values. */
4504
4505 #define FOR_EACH_ALIST_VALUE(head_var, list_var, value_var) \
4506 for ((list_var) = (head_var); \
4507 (CONSP (list_var) && ((value_var) = XCDR (XCAR (list_var)), true)); \
4508 (list_var) = XCDR (list_var))
4509
4510 /* Check whether it's time for GC, and run it if so. */
4511
4512 INLINE void
4513 maybe_gc (void)
4514 {
4515 if ((consing_since_gc > gc_cons_threshold
4516 && consing_since_gc > gc_relative_threshold)
4517 || (!NILP (Vmemory_full)
4518 && consing_since_gc > memory_full_cons_threshold))
4519 Fgarbage_collect ();
4520 }
4521
4522 INLINE bool
4523 functionp (Lisp_Object object)
4524 {
4525 if (SYMBOLP (object) && !NILP (Ffboundp (object)))
4526 {
4527 object = Findirect_function (object, Qt);
4528
4529 if (CONSP (object) && EQ (XCAR (object), Qautoload))
4530 {
4531 /* Autoloaded symbols are functions, except if they load
4532 macros or keymaps. */
4533 int i;
4534 for (i = 0; i < 4 && CONSP (object); i++)
4535 object = XCDR (object);
4536
4537 return ! (CONSP (object) && !NILP (XCAR (object)));
4538 }
4539 }
4540
4541 if (SUBRP (object))
4542 return XSUBR (object)->max_args != UNEVALLED;
4543 else if (COMPILEDP (object))
4544 return true;
4545 else if (CONSP (object))
4546 {
4547 Lisp_Object car = XCAR (object);
4548 return EQ (car, Qlambda) || EQ (car, Qclosure);
4549 }
4550 else
4551 return false;
4552 }
4553
4554 INLINE_HEADER_END
4555
4556 #endif /* EMACS_LISP_H */