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