#include <stdalign.h>
#include <stdarg.h>
+#include <stdbool.h>
#include <stddef.h>
#include <inttypes.h>
#include <limits.h>
#include <intprops.h>
+INLINE_HEADER_BEGIN
+#ifndef LISP_INLINE
+# define LISP_INLINE INLINE
+#endif
+
/* The ubiquitous max and min macros. */
#undef min
#undef max
eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
STRINGP (x), but a particular use of XSTRING is invoked only after
testing that STRINGP (x) is true, making the test redundant. */
-extern int suppress_checking EXTERNALLY_VISIBLE;
+extern bool suppress_checking EXTERNALLY_VISIBLE;
# define eassert(cond) \
((cond) || suppress_checking \
typedef struct { EMACS_INT i; } Lisp_Object;
#define XLI(o) (o).i
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
XIL (EMACS_INT i)
{
Lisp_Object o = { i };
return o;
}
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
LISP_MAKE_RVALUE (Lisp_Object o)
{
return o;
/* In the size word of a vector, this bit means the vector has been marked. */
-static ptrdiff_t const ARRAY_MARK_FLAG = PTRDIFF_MIN;
+static ptrdiff_t const ARRAY_MARK_FLAG
+#define ARRAY_MARK_FLAG PTRDIFF_MIN
+ = ARRAY_MARK_FLAG;
/* In the size word of a struct Lisp_Vector, this bit means it's really
some other vector-like object. */
-static ptrdiff_t const PSEUDOVECTOR_FLAG = PTRDIFF_MAX - PTRDIFF_MAX / 2;
+static ptrdiff_t const PSEUDOVECTOR_FLAG
+#define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
+ = PSEUDOVECTOR_FLAG;
/* In a pseudovector, the size field actually contains a word with one
PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to
#else /* not USE_LSB_TAG */
-static EMACS_INT const VALMASK = VAL_MAX;
+static EMACS_INT const VALMASK
+#define VALMASK VAL_MAX
+ = VALMASK;
#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS))
#define FIXNUM_OVERFLOW_P(i) \
(! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
-static inline ptrdiff_t
+LISP_INLINE ptrdiff_t
clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
{
return num < lower ? lower : num <= upper ? num : upper;
#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
-/* The IDX==IDX tries to detect when the macro argument is side-effecting. */
#define ASET(ARRAY, IDX, VAL) \
- (eassert ((IDX) == (IDX)), \
- eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
- AREF ((ARRAY), (IDX)) = (VAL))
+ (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \
+ XVECTOR (ARRAY)->contents[IDX] = (VAL))
/* Convenience macros for dealing with Lisp strings. */
#define CHECK_TYPE(ok, Qxxxp, x) \
do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
-/* Lisp fields are usually hidden from most code and accessed
- via special macros. Only select pieces of code, like the GC,
- are allowed to use INTERNAL_FIELD directly. Objects which
- aren't using this convention should be fixed. */
+/* Deprecated and will be removed soon. */
#define INTERNAL_FIELD(field) field ## _
typedef struct interval *INTERVAL;
-/* Complain if object is not string or buffer type */
+/* Complain if object is not string or buffer type. */
#define CHECK_STRING_OR_BUFFER(x) \
CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
-\f
-/* In a cons, the markbit of the car is the gc mark bit */
-
struct Lisp_Cons
{
- /* Please do not use the names of these elements in code other
- than the core lisp implementation. Use XCAR and XCDR below. */
+ /* Car of this cons cell. */
Lisp_Object car;
+
union
{
+ /* Cdr of this cons cell. */
Lisp_Object cdr;
+
+ /* Used to chain conses on a free list. */
struct Lisp_Cons *chain;
} u;
};
fields are not accessible as lvalues. (What if we want to switch to
a copying collector someday? Cached cons cell field addresses may be
invalidated at arbitrary points.) */
-#define XCAR_AS_LVALUE(c) (XCONS ((c))->car)
-#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr)
+#define XCAR_AS_LVALUE(c) (XCONS (c)->car)
+#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr)
/* Use these from normal code. */
#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c))
#define CDR_SAFE(c) \
(CONSP ((c)) ? XCDR ((c)) : Qnil)
-/* Nonzero if STR is a multibyte string. */
+/* True if STR is a multibyte string. */
#define STRING_MULTIBYTE(STR) \
(XSTRING (STR)->size_byte >= 0)
(STR) = empty_multibyte_string; \
else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
-/* Get text properties. */
-#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0)
-
-/* Set text properties. */
-#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
-
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
struct Lisp_String
} next;
};
+/* Regular vector is just a header plus array of Lisp_Objects. */
+
struct Lisp_Vector
{
struct vectorlike_header header;
Lisp_Object contents[1];
};
+/* A boolvector is a kind of vectorlike, with contents are like a string. */
+
+struct Lisp_Bool_Vector
+ {
+ /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
+ just the subtype information. */
+ struct vectorlike_header header;
+ /* This is the size in bits. */
+ EMACS_INT size;
+ /* This contains the actual bits, packed into bytes. */
+ unsigned char data[1];
+ };
+
+/* Some handy constants for calculating sizes
+ and offsets, mostly of vectorlike objects. */
+
+enum
+ {
+ header_size = offsetof (struct Lisp_Vector, contents),
+ bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
+ word_size = sizeof (Lisp_Object)
+ };
+
/* If a struct is made to look like a vector, this macro returns the length
of the shortest vector that would hold that struct. */
-#define VECSIZE(type) ((sizeof (type) \
- - offsetof (struct Lisp_Vector, contents[0]) \
- + sizeof (Lisp_Object) - 1) /* Round up. */ \
- / sizeof (Lisp_Object))
+
+#define VECSIZE(type) \
+ ((sizeof (type) - header_size + word_size - 1) / word_size)
/* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
at the end and we need to compute the number of Lisp_Object fields (the
ones that the GC needs to trace). */
-#define PSEUDOVECSIZE(type, nonlispfield) \
- ((offsetof (type, nonlispfield) - offsetof (struct Lisp_Vector, contents[0])) \
- / sizeof (Lisp_Object))
+
+#define PSEUDOVECSIZE(type, nonlispfield) \
+ ((offsetof (type, nonlispfield) - header_size) / word_size)
/* A char-table is a kind of vectorlike, with contents are like a
vector but with a few other slots. For some purposes, it makes
8-bit European characters. Do not check validity of CT. */
#define CHAR_TABLE_SET(CT, IDX, VAL) \
(ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
- ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
+ ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
: char_table_set (CT, IDX, VAL))
enum CHARTAB_SIZE_BITS
extern const int chartab_size[4];
-struct Lisp_Sub_Char_Table;
-
struct Lisp_Char_Table
{
/* HEADER.SIZE is the vector's size field, which also holds the
/* Minimum character covered by the sub char-table. */
Lisp_Object min_char;
+ /* Use set_sub_char_table_contents to set this. */
Lisp_Object contents[1];
};
-/* A boolvector is a kind of vectorlike, with contents are like a string. */
-struct Lisp_Bool_Vector
- {
- /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
- just the subtype information. */
- struct vectorlike_header header;
- /* This is the size in bits. */
- EMACS_INT size;
- /* This contains the actual bits, packed into bytes. */
- unsigned char data[1];
- };
-
/* This structure describes a built-in function.
It is generated by the DEFUN macro only.
defsubr makes it into a Lisp object.
SYMBOL_FORWARDED = 3
};
-/* Most code should use this macro to access
- Lisp fields in struct Lisp_Symbol. */
-
-#define SVAR(sym, field) ((sym)->INTERNAL_FIELD (field))
-
struct Lisp_Symbol
{
unsigned gcmarkbit : 1;
special (with `defvar' etc), and shouldn't be lexically bound. */
unsigned declared_special : 1;
- /* The symbol's name, as a Lisp string.
- The name "xname" is used to intentionally break code referring to
- the old field "name" of type pointer to struct Lisp_String. */
- Lisp_Object INTERNAL_FIELD (xname);
+ /* The symbol's name, as a Lisp string. */
+ Lisp_Object name;
/* Value of the symbol or Qunbound if unbound. Which alternative of the
union is used depends on the `redirect' field above. */
union {
- Lisp_Object INTERNAL_FIELD (value);
+ Lisp_Object value;
struct Lisp_Symbol *alias;
struct Lisp_Buffer_Local_Value *blv;
union Lisp_Fwd *fwd;
} val;
/* Function value of the symbol or Qunbound if not fboundp. */
- Lisp_Object INTERNAL_FIELD (function);
+ Lisp_Object function;
/* The symbol's property list. */
- Lisp_Object INTERNAL_FIELD (plist);
+ Lisp_Object plist;
/* Next symbol in obarray bucket, if the symbol is interned. */
struct Lisp_Symbol *next;
/* Value is name of symbol. */
-#define SYMBOL_VAL(sym) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), SVAR (sym, val.value))
-#define SYMBOL_ALIAS(sym) \
+#define SYMBOL_VAL(sym) \
+ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value)
+#define SYMBOL_ALIAS(sym) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
-#define SYMBOL_BLV(sym) \
+#define SYMBOL_BLV(sym) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
-#define SYMBOL_FWD(sym) \
+#define SYMBOL_FWD(sym) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
-#define SET_SYMBOL_VAL(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), SVAR (sym, val.value) = (v))
-#define SET_SYMBOL_ALIAS(sym, v) \
+#define SET_SYMBOL_VAL(sym, v) \
+ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
+#define SET_SYMBOL_ALIAS(sym, v) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
-#define SET_SYMBOL_BLV(sym, v) \
+#define SET_SYMBOL_BLV(sym, v) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
-#define SET_SYMBOL_FWD(sym, v) \
+#define SET_SYMBOL_FWD(sym, v) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
-#define SYMBOL_NAME(sym) \
- LISP_MAKE_RVALUE (SVAR (XSYMBOL (sym), xname))
+#define SYMBOL_NAME(sym) XSYMBOL (sym)->name
/* Value is non-zero if SYM is an interned symbol. */
-#define SYMBOL_INTERNED_P(sym) \
- (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
+#define SYMBOL_INTERNED_P(sym) \
+ (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
/* Value is non-zero if SYM is interned in initial_obarray. */
-#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
- (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
+#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
+ (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
/* Value is non-zero if symbol is considered a constant, i.e. its
value cannot be changed (there is an exception for keyword symbols,
whose value can be set to the keyword symbol itself). */
-#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
+#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
-#define DEFSYM(sym, name) \
+#define DEFSYM(sym, name) \
do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
\f
value gives the ratio of current entries in the hash table and the
size of the hash table. */
-#define DEFAULT_REHASH_THRESHOLD 0.8
+static double const DEFAULT_REHASH_THRESHOLD = 0.8;
/* Default factor by which to increase the size of a hash table. */
-#define DEFAULT_REHASH_SIZE 1.5
+static double const DEFAULT_REHASH_SIZE = 1.5;
-\f
/* These structures are used for various misc types. */
struct Lisp_Misc_Any /* Supertype of all Misc types. */
unsigned gcmarkbit : 1;
int spacer : 15;
struct Lisp_Overlay *next;
- Lisp_Object start, end, plist;
+ Lisp_Object start;
+ Lisp_Object end;
+ Lisp_Object plist;
};
/* Hold a C pointer for later use.
struct Lisp_Boolfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
- int *boolvar;
+ bool *boolvar;
};
/* Forwarding pointer to a Lisp_Object variable.
Lisp_Object valcell;
};
-#define BLV_FOUND(blv) \
- (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
-#define SET_BLV_FOUND(blv, v) \
- (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
-
-#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
-#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
-
/* Like Lisp_Objfwd except that value lives in a slot in the
current kboard. */
struct Lisp_Kboard_Objfwd
#define CHECK_WINDOW_CONFIGURATION(x) \
CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
-/* This macro rejects windows on the interior of the window tree as
- "dead", which is what we want; this is an argument-checking macro, and
- the user should never get access to interior windows.
-
- A window of any sort, leaf or interior, is dead if the buffer,
- vchild, and hchild members are all nil. */
-
-#define CHECK_LIVE_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) && !NILP (WVAR (XWINDOW (x), buffer)), \
+/* A window of any sort, leaf or interior, is "valid" if one of its
+ buffer, vchild, or hchild members is non-nil. */
+#define CHECK_VALID_WINDOW(x) \
+ CHECK_TYPE (WINDOWP (x) \
+ && (!NILP (XWINDOW (x)->buffer) \
+ || !NILP (XWINDOW (x)->vchild) \
+ || !NILP (XWINDOW (x)->hchild)), \
+ Qwindow_valid_p, x)
+
+/* A window is "live" if and only if it shows a buffer. */
+#define CHECK_LIVE_WINDOW(x) \
+ CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), \
Qwindow_live_p, x)
#define CHECK_PROCESS(x) \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* Non-zero if OBJ is a Lisp function. */
-#define FUNCTIONP(OBJ) \
- ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
- || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
- || COMPILEDP (OBJ) \
- || SUBRP (OBJ))
+#define FUNCTIONP(OBJ) functionp(OBJ)
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
-extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
+extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *);
extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
struct window;
struct frame;
+/* Simple access functions. */
+
+LISP_INLINE Lisp_Object *
+aref_addr (Lisp_Object array, ptrdiff_t idx)
+{
+ return & XVECTOR (array)->contents[idx];
+}
+
+LISP_INLINE void
+gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
+{
+ /* Like ASET, but also can be used in the garbage collector:
+ sweep_weak_table calls set_hash_key etc. while the table is marked. */
+ eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
+ XVECTOR (array)->contents[idx] = val;
+}
+
+/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
+
+LISP_INLINE void
+vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
+{
+ eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
+ memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+}
+
+/* Functions to modify hash tables. */
+
+LISP_INLINE void
+set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
+{
+ h->key_and_value = key_and_value;
+}
+
+LISP_INLINE void
+set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->key_and_value, 2 * idx, val);
+}
+
+LISP_INLINE void
+set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->key_and_value, 2 * idx + 1, val);
+}
+
+LISP_INLINE void
+set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
+{
+ h->next = next;
+}
+
+LISP_INLINE void
+set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->next, idx, val);
+}
+
+LISP_INLINE void
+set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
+{
+ h->hash = hash;
+}
+
+LISP_INLINE void
+set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->hash, idx, val);
+}
+
+LISP_INLINE void
+set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
+{
+ h->index = index;
+}
+
+LISP_INLINE void
+set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->index, idx, val);
+}
+
+/* Use these functions to set Lisp_Object
+ or pointer slots of struct Lisp_Symbol. */
+
+LISP_INLINE void
+set_symbol_name (Lisp_Object sym, Lisp_Object name)
+{
+ XSYMBOL (sym)->name = name;
+}
+
+LISP_INLINE void
+set_symbol_function (Lisp_Object sym, Lisp_Object function)
+{
+ XSYMBOL (sym)->function = function;
+}
+
+LISP_INLINE void
+set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
+{
+ XSYMBOL (sym)->plist = plist;
+}
+
+LISP_INLINE void
+set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
+{
+ XSYMBOL (sym)->next = next;
+}
+
+/* Buffer-local (also frame-local) variable access functions. */
+
+LISP_INLINE int
+blv_found (struct Lisp_Buffer_Local_Value *blv)
+{
+ eassert (blv->found == !EQ (blv->defcell, blv->valcell));
+ return blv->found;
+}
+
+LISP_INLINE void
+set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
+{
+ eassert (found == !EQ (blv->defcell, blv->valcell));
+ blv->found = found;
+}
+
+LISP_INLINE Lisp_Object
+blv_value (struct Lisp_Buffer_Local_Value *blv)
+{
+ return XCDR (blv->valcell);
+}
+
+LISP_INLINE void
+set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ XSETCDR (blv->valcell, val);
+}
+
+LISP_INLINE void
+set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->where = val;
+}
+
+LISP_INLINE void
+set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->defcell = val;
+}
+
+LISP_INLINE void
+set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->valcell = val;
+}
+
+/* Set overlay's property list. */
+
+LISP_INLINE void
+set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
+{
+ XOVERLAY (overlay)->plist = plist;
+}
+
+/* Get text properties of S. */
+
+LISP_INLINE INTERVAL
+string_intervals (Lisp_Object s)
+{
+ return XSTRING (s)->intervals;
+}
+
+/* Set text properties of S to I. */
+
+LISP_INLINE void
+set_string_intervals (Lisp_Object s, INTERVAL i)
+{
+ XSTRING (s)->intervals = i;
+}
+
+/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
+ of setting slots directly. */
+
+LISP_INLINE void
+set_char_table_ascii (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->ascii = val;
+}
+LISP_INLINE void
+set_char_table_defalt (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->defalt = val;
+}
+LISP_INLINE void
+set_char_table_parent (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->parent = val;
+}
+LISP_INLINE void
+set_char_table_purpose (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->purpose = val;
+}
+
+/* Set different slots in (sub)character tables. */
+
+LISP_INLINE void
+set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
+ XCHAR_TABLE (table)->extras[idx] = val;
+}
+
+LISP_INLINE void
+set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
+ XCHAR_TABLE (table)->contents[idx] = val;
+}
+
+LISP_INLINE void
+set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ XSUB_CHAR_TABLE (table)->contents[idx] = val;
+}
+
/* Defined in data.c. */
extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
extern Lisp_Object Qfloatp;
extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
-extern Lisp_Object Qinteger, Qinterval, Qsymbol, Qstring;
-extern Lisp_Object Qmisc, Qvector, Qfloat, Qcons, Qbuffer;
+extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
Lisp_Object);
extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int);
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
extern void syms_of_data (void);
extern void init_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
/* Defined in coding.c */
extern Lisp_Object Qcharset;
extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
- ptrdiff_t, int, int, Lisp_Object);
+ ptrdiff_t, bool, bool, Lisp_Object);
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
#endif
extern Lisp_Object selected_frame;
extern Lisp_Object Vwindow_system;
-void duration_to_sec_usec (double, int *, int *);
extern Lisp_Object sit_for (Lisp_Object, int, int);
extern void init_display (void);
extern void syms_of_display (void);
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
-extern int push_message (void);
+extern bool push_message (void);
extern Lisp_Object pop_message_unwind (Lisp_Object);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
extern void malloc_warning (const char *);
extern _Noreturn void memory_full (size_t);
extern _Noreturn void buffer_memory_full (ptrdiff_t);
-extern int survives_gc_p (Lisp_Object);
+extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
extern void refill_memory_reserve (void);
/* Make unibyte string from C string when the length isn't known. */
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
build_unibyte_string (const char *str)
{
return make_unibyte_string (str, strlen (str));
extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_specified_string (const char *,
- ptrdiff_t, ptrdiff_t, int);
-extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int);
+ ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
/* Make a string allocated in pure space, use STR as string data. */
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
build_pure_c_string (const char *str)
{
return make_pure_c_string (str, strlen (str));
/* Make a string from the data at STR, treating it as multibyte if the
data warrants. */
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
build_string (const char *str)
{
return make_string (str, strlen (str));
extern struct frame *allocate_frame (void);
extern struct Lisp_Process *allocate_process (void);
extern struct terminal *allocate_terminal (void);
-extern int gc_in_progress;
-extern int abort_on_gc;
+extern bool gc_in_progress;
+extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
int *, int *);
-extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
-extern Lisp_Object char_table_set_range (Lisp_Object, int, int,
- Lisp_Object);
+extern void char_table_set (Lisp_Object, int, Lisp_Object);
+extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
extern int char_table_translate (Lisp_Object, int);
extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
Lisp_Object),
extern void init_lread (void);
extern void syms_of_lread (void);
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
intern (const char *str)
{
return intern_1 (str, strlen (str));
}
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
intern_c_string (const char *str)
{
return intern_c_string_1 (str, strlen (str));
extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
-extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_n
+ (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
+ Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern void specbind (Lisp_Object, Lisp_Object);
extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern void set_time_zone_rule (const char *);
/* Defined in buffer.c. */
-extern int mouse_face_overlay_overlaps (Lisp_Object);
+extern bool mouse_face_overlay_overlaps (Lisp_Object);
extern _Noreturn void nsberror (Lisp_Object);
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
-extern void report_overlay_modification (Lisp_Object, Lisp_Object, int,
+extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
-extern int overlay_touches_p (ptrdiff_t);
+extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object Vbuffer_alist;
extern Lisp_Object set_buffer_if_live (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern void syms_of_indent (void);
/* Defined in frame.c. */
-extern Lisp_Object Qonly;
+extern Lisp_Object Qonly, Qnone;
extern Lisp_Object Qvisible;
extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
#ifndef DOS_NT
_Noreturn
#endif
-extern int child_setup (int, int, int, char **, int, Lisp_Object);
+extern int child_setup (int, int, int, char **, bool, Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
extern void set_initial_environment (void);
extern void syms_of_dired (void);
extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
- int, Lisp_Object);
+ bool, Lisp_Object);
/* Defined in term.c */
extern int *char_ins_del_vector;
/* Set up the name of the machine we're running on. */
extern void init_system_name (void);
-static char const DIRECTORY_SEP = '/';
-
-/* Use this to suppress gcc's warnings. */
-#ifdef lint
-
-/* Use CODE only if lint checking is in effect. */
-# define IF_LINT(Code) Code
-
-/* Assume that the expression COND is true. This differs in intent
- from 'assert', as it is a message from the programmer to the compiler. */
-# define lint_assume(cond) ((cond) ? (void) 0 : abort ())
-
-#else
-# define IF_LINT(Code) /* empty */
-# define lint_assume(cond) ((void) (0 && (cond)))
-#endif
-
/* We used to use `abs', but that clashes with system headers on some
platforms, and using a name reserved by Standard C is a bad idea
anyway. */
enum MAX_ALLOCA { MAX_ALLOCA = 16*1024 };
extern Lisp_Object safe_alloca_unwind (Lisp_Object);
+extern void *record_xmalloc (size_t);
#define USE_SAFE_ALLOCA \
- ptrdiff_t sa_count = SPECPDL_INDEX (); int sa_must_free = 0
+ ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = 0
/* SAFE_ALLOCA allocates a simple buffer. */
-#define SAFE_ALLOCA(buf, type, size) \
- do { \
- if ((size) < MAX_ALLOCA) \
- buf = (type) alloca (size); \
- else \
- { \
- buf = xmalloc (size); \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, \
- make_save_value (buf, 0)); \
- } \
- } while (0)
+#define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
+ ? alloca (size) \
+ : (sa_must_free = 1, record_xmalloc (size)))
/* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
NITEMS items, each of the same type as *BUF. MULTIPLIER must
/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
-#define SAFE_ALLOCA_LISP(buf, nelt) \
- do { \
- if ((nelt) < MAX_ALLOCA / sizeof (Lisp_Object)) \
- buf = (Lisp_Object *) alloca ((nelt) * sizeof (Lisp_Object)); \
- else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)) \
- { \
- Lisp_Object arg_; \
- buf = xmalloc ((nelt) * sizeof (Lisp_Object)); \
- arg_ = make_save_value (buf, nelt); \
- XSAVE_VALUE (arg_)->dogc = 1; \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, arg_); \
- } \
- else \
- memory_full (SIZE_MAX); \
+#define SAFE_ALLOCA_LISP(buf, nelt) \
+ do { \
+ if ((nelt) < MAX_ALLOCA / word_size) \
+ buf = alloca ((nelt) * word_size); \
+ else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
+ { \
+ Lisp_Object arg_; \
+ buf = xmalloc ((nelt) * word_size); \
+ arg_ = make_save_value (buf, nelt); \
+ XSAVE_VALUE (arg_)->dogc = 1; \
+ sa_must_free = 1; \
+ record_unwind_protect (safe_alloca_unwind, arg_); \
+ } \
+ else \
+ memory_full (SIZE_MAX); \
} while (0)
/* Check whether it's time for GC, and run it if so. */
-static inline void
+LISP_INLINE void
maybe_gc (void)
{
if ((consing_since_gc > gc_cons_threshold
Fgarbage_collect ();
}
+LISP_INLINE int
+functionp (Lisp_Object object)
+{
+ if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+ {
+ object = Findirect_function (object, Qt);
+
+ if (CONSP (object) && EQ (XCAR (object), Qautoload))
+ {
+ /* Autoloaded symbols are functions, except if they load
+ macros or keymaps. */
+ int i;
+ for (i = 0; i < 4 && CONSP (object); i++)
+ object = XCDR (object);
+
+ return ! (CONSP (object) && !NILP (XCAR (object)));
+ }
+ }
+
+ if (SUBRP (object))
+ return XSUBR (object)->max_args != UNEVALLED;
+ else if (COMPILEDP (object))
+ return 1;
+ else if (CONSP (object))
+ {
+ Lisp_Object car = XCAR (object);
+ return EQ (car, Qlambda) || EQ (car, Qclosure);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER_END
+
#endif /* EMACS_LISP_H */
HCoop / bpt / emacs.git / blobdiff