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