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