diff options
Diffstat (limited to 'src/lisp.h')
| -rw-r--r-- | src/lisp.h | 570 |
1 files changed, 443 insertions, 127 deletions
diff --git a/src/lisp.h b/src/lisp.h index ab0be3b281b..8053bbc9777 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <inttypes.h> #include <limits.h> +#include <attribute.h> #include <intprops.h> #include <verify.h> @@ -137,17 +138,9 @@ verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); /* Use pD to format ptrdiff_t values, which suffice for indexes into buffers and strings. Emacs never allocates objects larger than PTRDIFF_MAX bytes, as they cause problems with pointer subtraction. - In C99, pD can always be "t"; configure it here for the sake of - pre-C99 libraries such as glibc 2.0 and Solaris 8. */ -#if PTRDIFF_MAX == INT_MAX -# define pD "" -#elif PTRDIFF_MAX == LONG_MAX -# define pD "l" -#elif PTRDIFF_MAX == LLONG_MAX -# define pD "ll" -#else -# define pD "t" -#endif + In C99, pD can always be "t", as we no longer need to worry about + pre-C99 libraries such as glibc 2.0 (1997) and Solaris 8 (2000). */ +#define pD "t" /* Convenience macro for rarely-used functions that do not return. */ #define AVOID _Noreturn ATTRIBUTE_COLD void @@ -251,6 +244,11 @@ DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK) # define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) DEFINE_GDB_SYMBOL_END (VALMASK) +/* Ignore 'alignas' on compilers lacking it. */ +#if !defined alignas && !defined __alignas_is_defined +# define alignas(a) +#endif + /* Minimum alignment requirement for Lisp objects, imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, @@ -356,18 +354,41 @@ typedef EMACS_INT Lisp_Word; # endif #endif +#define lisp_h_PSEUDOVECTORP(a,code) \ + (lisp_h_VECTORLIKEP((a)) && \ + ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size \ + & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ + == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) + #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) -#define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) +#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) + +/* FIXME: Do we really need to inline the whole thing? + * What about keeping the part after `symbols_with_pos_enabled` in + * a separate function? */ +#define lisp_h_EQ(x, y) \ + ((XLI ((x)) == XLI ((y))) \ + || (symbols_with_pos_enabled \ + && (SYMBOL_WITH_POS_P ((x)) \ + ? (BARE_SYMBOL_P ((y)) \ + ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ + : SYMBOL_WITH_POS_P((y)) \ + && (XLI (XSYMBOL_WITH_POS((x))->sym) \ + == XLI (XSYMBOL_WITH_POS((y))->sym))) \ + : (SYMBOL_WITH_POS_P ((y)) \ + && BARE_SYMBOL_P ((x)) \ + && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) + #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) -#define lisp_h_NILP(x) EQ (x, Qnil) +#define lisp_h_NILP(x) BASE_EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -376,7 +397,10 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS) +#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol) +#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) || \ + (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x)))))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -421,11 +445,12 @@ typedef EMACS_INT Lisp_Word; # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) # define XLP(o) lisp_h_XLP (o) +# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x) # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) -# define EQ(x, y) lisp_h_EQ (x, y) +# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) @@ -433,7 +458,7 @@ typedef EMACS_INT Lisp_Word; # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -# define SYMBOLP(x) lisp_h_SYMBOLP (x) +/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) @@ -592,9 +617,11 @@ extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE; extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ +extern bool symbols_with_pos_enabled; extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); +extern void defalias (Lisp_Object symbol, Lisp_Object definition); /* Defined in emacs.c. */ @@ -941,7 +968,7 @@ typedef EMACS_UINT Lisp_Word_tag; ? ((y) - 1 + (x)) & ~ ((y) - 1) \ : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y)) -#include "globals.h" +#include <globals.h> /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents @@ -976,57 +1003,12 @@ union vectorlike_header ptrdiff_t size; }; -INLINE bool -(SYMBOLP) (Lisp_Object x) -{ - return lisp_h_SYMBOLP (x); -} - -INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -XSYMBOL (Lisp_Object a) -{ - eassert (SYMBOLP (a)); - intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); - void *p = (char *) lispsym + i; - return p; -} - -INLINE Lisp_Object -make_lisp_symbol (struct Lisp_Symbol *sym) -{ - /* GCC 7 x86-64 generates faster code if lispsym is - cast to char * rather than to intptr_t. */ - char *symoffset = (char *) ((char *) sym - (char *) lispsym); - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); - eassert (XSYMBOL (a) == sym); - return a; -} - -INLINE Lisp_Object -builtin_lisp_symbol (int index) -{ - return make_lisp_symbol (&lispsym[index]); -} - -INLINE bool -c_symbol_p (struct Lisp_Symbol *sym) +struct Lisp_Symbol_With_Pos { - char *bp = (char *) lispsym; - char *sp = (char *) sym; - if (PTRDIFF_MAX < INTPTR_MAX) - return bp <= sp && sp < bp + sizeof lispsym; - else - { - ptrdiff_t offset = sp - bp; - return 0 <= offset && offset < sizeof lispsym; - } -} - -INLINE void -(CHECK_SYMBOL) (Lisp_Object x) -{ - lisp_h_CHECK_SYMBOL (x); -} + union vectorlike_header header; + Lisp_Object sym; /* A symbol */ + Lisp_Object pos; /* A fixnum */ +} GCALIGNED_STRUCT; /* In the size word of a vector, this bit means the vector has been marked. */ @@ -1051,6 +1033,7 @@ enum pvec_type PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER, + PVEC_SYMBOL_WITH_POS, PVEC_MISC_PTR, PVEC_USER_PTR, PVEC_PROCESS, @@ -1070,6 +1053,7 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, PVEC_NATIVE_COMP_UNIT, + PVEC_SQLITE, /* These should be last, for internal_equal and sxhash_obj. */ PVEC_COMPILED, @@ -1109,6 +1093,92 @@ enum More_Lisp_Bits values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) + +INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + return lisp_h_PSEUDOVECTORP (a, code); +} + +INLINE bool +(BARE_SYMBOL_P) (Lisp_Object x) +{ + return lisp_h_BARE_SYMBOL_P (x); +} + +INLINE bool +(SYMBOL_WITH_POS_P) (Lisp_Object x) +{ + return lisp_h_SYMBOL_WITH_POS_P (x); +} + +INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return lisp_h_SYMBOLP (x); +} + +INLINE struct Lisp_Symbol_With_Pos * +XSYMBOL_WITH_POS (Lisp_Object a) +{ + eassert (SYMBOL_WITH_POS_P (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +(XBARE_SYMBOL) (Lisp_Object a) +{ + eassert (BARE_SYMBOL_P (a)); + intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); + void *p = (char *) lispsym + i; + return p; +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +(XSYMBOL) (Lisp_Object a) +{ + eassert (SYMBOLP ((a))); + if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) + return XBARE_SYMBOL (a); + return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym); +} + +INLINE Lisp_Object +make_lisp_symbol (struct Lisp_Symbol *sym) +{ + /* GCC 7 x86-64 generates faster code if lispsym is + cast to char * rather than to intptr_t. */ + char *symoffset = (char *) ((char *) sym - (char *) lispsym); + Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + eassert (XSYMBOL (a) == sym); + return a; +} + +INLINE Lisp_Object +builtin_lisp_symbol (int index) +{ + return make_lisp_symbol (&lispsym[index]); +} + +INLINE bool +c_symbol_p (struct Lisp_Symbol *sym) +{ + char *bp = (char *) lispsym; + char *sp = (char *) sym; + if (PTRDIFF_MAX < INTPTR_MAX) + return bp <= sp && sp < bp + sizeof lispsym; + else + { + ptrdiff_t offset = sp - bp; + return 0 <= offset && offset < sizeof lispsym; + } +} + +INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} /* True if the possibly-unsigned integer I doesn't fit in a fixnum. */ @@ -1240,7 +1310,14 @@ make_fixed_natnum (EMACS_INT n) } /* Return true if X and Y are the same object. */ +INLINE bool +(BASE_EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_BASE_EQ (x, y); +} +/* Return true if X and Y are the same object, reckoning a symbol with + position as being the same as the bare symbol. */ INLINE bool (EQ) (Lisp_Object x, Lisp_Object y) { @@ -1482,7 +1559,9 @@ struct Lisp_String struct { ptrdiff_t size; /* MSB is used as the markbit. */ - ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */ + ptrdiff_t size_byte; /* Set to -1 for unibyte strings, + -2 for data in rodata, + -3 for immovable unibyte strings. */ INTERVAL intervals; /* Text properties in this string. */ unsigned char *data; } s; @@ -1630,6 +1709,13 @@ CHECK_STRING_NULL_BYTES (Lisp_Object string) Qfilenamep, string); } +/* True if STR is immovable (whose data won't move during GC). */ +INLINE bool +string_immovable_p (Lisp_Object str) +{ + return XSTRING (str)->u.s.size_byte == -3; +} + /* A regular vector is just a header plus an array of Lisp_Objects. */ struct Lisp_Vector @@ -1706,21 +1792,6 @@ PSEUDOVECTOR_TYPEP (const union vectorlike_header *a, enum pvec_type code) == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); } -/* True if A is a pseudovector whose code is CODE. */ -INLINE bool -PSEUDOVECTORP (Lisp_Object a, int code) -{ - if (! VECTORLIKEP (a)) - return false; - else - { - /* Converting to union vectorlike_header * avoids aliasing issues. */ - return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike, - union vectorlike_header), - code); - } -} - /* A boolvector is a kind of vectorlike, with contents like a string. */ struct Lisp_Bool_Vector @@ -2557,6 +2628,17 @@ xmint_pointer (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } +struct Lisp_Sqlite +{ + union vectorlike_header header; + void *db; + void *stmt; + char *name; + void (*finalizer) (void *); + bool eof; + bool is_statement; +} GCALIGNED_STRUCT; + struct Lisp_User_Ptr { union vectorlike_header header; @@ -2621,6 +2703,22 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } +INLINE Lisp_Object +SYMBOL_WITH_POS_SYM (Lisp_Object a) +{ + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->sym; +} + +INLINE Lisp_Object +SYMBOL_WITH_POS_POS (Lisp_Object a) +{ + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->pos; +} + INLINE bool USER_PTRP (Lisp_Object x) { @@ -2635,6 +2733,31 @@ XUSER_PTR (Lisp_Object a) } INLINE bool +SQLITEP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_SQLITE); +} + +INLINE bool +SQLITE (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SQLITE); +} + +INLINE void +CHECK_SQLITE (Lisp_Object x) +{ + CHECK_TYPE (SQLITE (x), Qsqlitep, x); +} + +INLINE struct Lisp_Sqlite * +XSQLITE (Lisp_Object a) +{ + eassert (SQLITEP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite); +} + +INLINE bool BIGNUMP (Lisp_Object x) { return PSEUDOVECTORP (x, PVEC_BIGNUM); @@ -3162,6 +3285,7 @@ enum specbind_tag { SPECPDL_UNWIND_EXCURSION, /* Likewise, on an excursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ + SPECPDL_NOP, /* A filler. */ #ifdef HAVE_MODULES SPECPDL_MODULE_RUNTIME, /* A live module runtime. */ SPECPDL_MODULE_ENVIRONMENT, /* A live module environment. */ @@ -3215,9 +3339,6 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; - /* Normally this is unused; but it is set to the symbol's - current value when a thread is swapped out. */ - Lisp_Object saved_value; } let; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -3228,10 +3349,144 @@ union specbinding } bt; }; +/* We use 64-bit platforms as a proxy for ones with ABIs that treat + small structs efficiently. */ +#if SIZE_MAX > 0xffffffff +#define WRAP_SPECPDL_REF 1 +#endif + +/* Abstract reference to to a specpdl entry. + The number is always a multiple of sizeof (union specbinding). */ +#ifdef WRAP_SPECPDL_REF +/* Use a proper type for specpdl_ref if it does not make the code slower, + since the type checking is quite useful. */ +typedef struct { ptrdiff_t bytes; } specpdl_ref; +#else +typedef ptrdiff_t specpdl_ref; +#endif + +/* Internal use only. */ +INLINE specpdl_ref +wrap_specpdl_ref (ptrdiff_t bytes) +{ +#ifdef WRAP_SPECPDL_REF + return (specpdl_ref){.bytes = bytes}; +#else + return bytes; +#endif +} + +/* Internal use only. */ INLINE ptrdiff_t +unwrap_specpdl_ref (specpdl_ref ref) +{ +#ifdef WRAP_SPECPDL_REF + return ref.bytes; +#else + return ref; +#endif +} + +INLINE specpdl_ref +specpdl_count_to_ref (ptrdiff_t count) +{ + return wrap_specpdl_ref (count * sizeof (union specbinding)); +} + +INLINE ptrdiff_t +specpdl_ref_to_count (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) / sizeof (union specbinding); +} + +/* Whether two `specpdl_ref' refer to the same entry. */ +INLINE bool +specpdl_ref_eq (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) == unwrap_specpdl_ref (b); +} + +/* Whether `a' refers to an earlier entry than `b'. */ +INLINE bool +specpdl_ref_lt (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) < unwrap_specpdl_ref (b); +} + +INLINE bool +specpdl_ref_valid_p (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) >= 0; +} + +INLINE specpdl_ref +make_invalid_specpdl_ref (void) +{ + return wrap_specpdl_ref (-1); +} + +/* Return a reference that is `delta' steps more recent than `ref'. + `delta' may be negative or zero. */ +INLINE specpdl_ref +specpdl_ref_add (specpdl_ref ref, ptrdiff_t delta) +{ + return wrap_specpdl_ref (unwrap_specpdl_ref (ref) + + delta * sizeof (union specbinding)); +} + +INLINE union specbinding * +specpdl_ref_to_ptr (specpdl_ref ref) +{ + return (union specbinding *)((char *)specpdl + unwrap_specpdl_ref (ref)); +} + +/* Return a reference to the most recent specpdl entry. */ +INLINE specpdl_ref SPECPDL_INDEX (void) { - return specpdl_ptr - specpdl; + return wrap_specpdl_ref ((char *)specpdl_ptr - (char *)specpdl); +} + +INLINE bool +backtrace_debug_on_exit (union specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.debug_on_exit; +} + +void grow_specpdl_allocation (void); + +/* Grow the specpdl stack by one entry. + The caller should have already initialized the entry. + Signal an error on stack overflow. + + Make sure that there is always one unused entry past the top of the + stack, so that the just-initialized entry is safely unwound if + memory exhausted and an error is signaled here. Also, allocate a + never-used entry just before the bottom of the stack; sometimes its + address is taken. */ +INLINE void +grow_specpdl (void) +{ + specpdl_ptr++; + if (specpdl_ptr == specpdl_end) + grow_specpdl_allocation (); +} + +INLINE specpdl_ref +record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) +{ + specpdl_ref count = SPECPDL_INDEX (); + + eassert (nargs >= UNEVALLED); + specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; + specpdl_ptr->bt.debug_on_exit = false; + specpdl_ptr->bt.function = function; + current_thread->stack_top = specpdl_ptr->bt.args = args; + specpdl_ptr->bt.nargs = nargs; + grow_specpdl (); + + return count; } /* This structure helps implement the `catch/throw' and `condition-case/signal' @@ -3290,19 +3545,42 @@ struct handler but a few others are handled by storing their value here. */ sys_jmp_buf jmp; EMACS_INT f_lisp_eval_depth; - ptrdiff_t pdlcount; + specpdl_ref pdlcount; + Lisp_Object *act_rec; int poll_suppress_count; int interrupt_input_blocked; }; extern Lisp_Object memory_signal_data; -extern void maybe_quit (void); - /* True if ought to quit now. */ #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) +extern bool volatile pending_signals; +extern void process_pending_signals (void); +extern void probably_quit (void); + +/* Check quit-flag and quit if it is non-nil. Typing C-g does not + directly cause a quit; it only sets Vquit_flag. So the program + needs to call maybe_quit at times when it is safe to quit. Every + loop that might run for a long time or might not exit ought to call + maybe_quit at least once, at a safe place. Unless that is + impossible, of course. But it is very desirable to avoid creating + loops where maybe_quit is impossible. + + If quit-flag is set to `kill-emacs' the SIGINT handler has received + a request to exit Emacs when it is safe to do. + + When not quitting, process any pending signals. */ + +INLINE void +maybe_quit (void) +{ + if (!NILP (Vquit_flag) || pending_signals) + probably_quit (); +} + /* Process a quit rarely, based on a counter COUNT, for efficiency. "Rarely" means once per USHRT_MAX + 1 times; this is somewhat arbitrary, but efficient. */ @@ -3332,7 +3610,7 @@ struct frame; /* Define if the windowing system provides a menu bar. */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \ - || defined (HAVE_NS) || defined (USE_GTK) + || defined (HAVE_NS) || defined (USE_GTK) || defined (HAVE_HAIKU) #define HAVE_EXT_MENU_BAR true #endif @@ -3780,6 +4058,9 @@ extern Lisp_Object safe_eval (Lisp_Object); extern bool pos_visible_p (struct window *, ptrdiff_t, int *, int *, int *, int *, int *, int *); +/* Defined in sqlite.c. */ +extern void syms_of_sqlite (void); + /* Defined in xsettings.c. */ extern void syms_of_xsettings (void); @@ -3807,6 +4088,7 @@ extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); extern void mark_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); +extern void mark_memory (void const *start, void const *end); /* Force callee-saved registers and register windows onto the stack, so that conservative garbage collection can see their values. */ @@ -3929,6 +4211,7 @@ extern Lisp_Object make_specified_string (const char *, 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); +extern void pin_string (Lisp_Object string); /* Make a string allocated in pure space, use STR as string data. */ @@ -3949,7 +4232,8 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3962,7 +4246,8 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); allocate_vector has a similar problem. */ -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) @@ -3994,7 +4279,8 @@ make_nil_vector (ptrdiff_t size) } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, - enum pvec_type); + enum pvec_type) + ATTRIBUTE_RETURNS_NONNULL; /* Allocate uninitialized pseudovector with no Lisp_Object slots. */ @@ -4020,13 +4306,14 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int, extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); -extern ptrdiff_t inhibit_garbage_collection (void); +extern specpdl_ref inhibit_garbage_collection (void); +extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); -extern struct buffer * allocate_buffer (void); +extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); /* Defined in gmalloc.c. */ @@ -4184,7 +4471,8 @@ 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 Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); -extern struct handler *push_handler (Lisp_Object, enum handlertype); +extern struct handler *push_handler (Lisp_Object, enum handlertype) + ATTRIBUTE_RETURNS_NONNULL; extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); @@ -4196,18 +4484,20 @@ extern void record_unwind_protect_void (void (*) (void)); extern void record_unwind_protect_excursion (void); extern void record_unwind_protect_nothing (void); extern void record_unwind_protect_module (enum specbind_tag, void *); -extern void clear_unwind_protect (ptrdiff_t); -extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); -extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); -extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); -extern void rebind_for_thread_switch (void); -extern void unbind_for_thread_switch (struct thread_state *); +extern void clear_unwind_protect (specpdl_ref); +extern void set_unwind_protect (specpdl_ref, void (*) (Lisp_Object), + Lisp_Object); +extern void set_unwind_protect_ptr (specpdl_ref, void (*) (void *), void *); +extern Lisp_Object unbind_to (specpdl_ref, Lisp_Object); +void specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only); extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern AVOID verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); extern Lisp_Object vformat_string (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); -extern void un_autoload (Lisp_Object); +extern Lisp_Object load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix); extern Lisp_Object call_debugger (Lisp_Object arg); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); @@ -4216,11 +4506,13 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); extern void prog_ignore (Lisp_Object); -extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +void do_debug_on_call (Lisp_Object code, specpdl_ref count); +Lisp_Object funcall_general (Lisp_Object fun, + ptrdiff_t numargs, Lisp_Object *args); /* Defined in unexmacosx.c. */ #if defined DARWIN_OS && defined HAVE_UNEXEC @@ -4325,9 +4617,10 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern char *splice_dir_file (char *, char const *, char const *); +extern char *splice_dir_file (char *, char const *, char const *) + ATTRIBUTE_RETURNS_NONNULL; extern bool file_name_absolute_p (const char *); -extern char const *get_homedir (void); +extern char const *get_homedir (void) ATTRIBUTE_RETURNS_NONNULL; extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4426,7 +4719,7 @@ extern Lisp_Object menu_bar_items (Lisp_Object); extern Lisp_Object tab_bar_items (Lisp_Object, int *); extern Lisp_Object tool_bar_items (Lisp_Object, int *); extern void discard_mouse_events (void); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) void handle_input_available_signal (int); #endif extern Lisp_Object pending_funcalls; @@ -4481,7 +4774,7 @@ INLINE void fixup_locale (void) {} INLINE void synchronize_system_messages_locale (void) {} INLINE void synchronize_system_time_locale (void) {} #endif -extern char *emacs_strerror (int); +extern char *emacs_strerror (int) ATTRIBUTE_RETURNS_NONNULL; extern void shut_down_emacs (int, Lisp_Object); /* True means don't do interactive redisplay and don't change tty modes. */ @@ -4547,7 +4840,7 @@ extern void setup_process_coding_systems (Lisp_Object); extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, const char *, const sigset_t *); -extern char **make_environment_block (Lisp_Object); +extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL; extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -4561,9 +4854,24 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, ptrdiff_t, Lisp_Object *); +extern Lisp_Object exec_byte_code (Lisp_Object, ptrdiff_t, + ptrdiff_t, Lisp_Object *); extern Lisp_Object get_byte_code_arity (Lisp_Object); +extern void init_bc_thread (struct bc_thread_state *bc); +extern void free_bc_thread (struct bc_thread_state *bc); +extern void mark_bytecode (struct bc_thread_state *bc); + +INLINE Lisp_Object * +get_act_rec (struct thread_state *th) +{ + return th->bc.fp; +} + +INLINE void +set_act_rec (struct thread_state *th, Lisp_Object *act_rec) +{ + th->bc.fp = act_rec; +} /* Defined in macros.c. */ extern void init_macros (void); @@ -4816,17 +5124,24 @@ extern char my_edata[]; extern char my_endbss[]; extern char *my_endbss_static; -extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); +extern void *xmalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xzalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xrealloc (void *, size_t) + ATTRIBUTE_ALLOC_SIZE ((2)) ATTRIBUTE_RETURNS_NONNULL; extern void xfree (void *); -extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); +extern void *xnmalloc (ptrdiff_t, ptrdiff_t) + ATTRIBUTE_MALLOC_SIZE ((1,2)) ATTRIBUTE_RETURNS_NONNULL; extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t) - ATTRIBUTE_ALLOC_SIZE ((2,3)); -extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); - -extern char *xstrdup (const char *) ATTRIBUTE_MALLOC; -extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; + ATTRIBUTE_ALLOC_SIZE ((2,3)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; + +extern char *xstrdup (char const *) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; +extern char *xlispstrdup (Lisp_Object) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating @@ -4876,11 +5191,12 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); +extern void *record_xmalloc (size_t) + ATTRIBUTE_ALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ - ptrdiff_t sa_count = SPECPDL_INDEX () + specpdl_ref sa_count = SPECPDL_INDEX () #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size)) @@ -4918,9 +5234,9 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define SAFE_FREE() safe_free (sa_count) INLINE void -safe_free (ptrdiff_t sa_count) +safe_free (specpdl_ref sa_count) { - while (specpdl_ptr != specpdl + sa_count) + while (specpdl_ptr != specpdl_ref_to_ptr (sa_count)) { specpdl_ptr--; if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR) @@ -4946,9 +5262,9 @@ safe_free (ptrdiff_t sa_count) safe_free_unbind_to (count, sa_count, val) INLINE Lisp_Object -safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) +safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) { - eassert (count <= sa_count); + eassert (!specpdl_ref_lt (sa_count, count)); return unbind_to (count, val); } |