X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8865587c55f251ac624e6730505de66d15b28562..f69cd6bfa114ea02f3d10ddb2fe809a26eafb9a4:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index 15fe40db78..02c19690ad 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1,4 +1,4 @@ -/* Fundamental definitions for GNU Emacs Lisp interpreter. +/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*- Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation, Inc. @@ -258,7 +258,7 @@ enum Lisp_Bits /* The maximum value that can be stored in a EMACS_INT, assuming all bits other than the type bits contribute to a nonnegative signed value. - This can be used in #if, e.g., '#if USB_TAG' below expands to an + This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an expression involving VAL_MAX. */ #define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1)) @@ -301,10 +301,6 @@ error !; and/or via a function definition like this: - LISP_MACRO_DEFUN (OP, Lisp_Object, (Lisp_Object x), (x)) - - which macro-expands to this: - Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); } without worrying about the implementations diverging, since @@ -351,8 +347,6 @@ error !; #define lisp_h_XCONS(a) \ (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) #define lisp_h_XHASH(a) XUINT (a) -#define lisp_h_XPNTR(a) \ - (SYMBOLP (a) ? XSYMBOL (a) : (void *) ((intptr_t) (XLI (a) & VALMASK))) #ifndef GC_CHECK_CONS_LIST # define lisp_h_check_cons_list() ((void) 0) #endif @@ -397,7 +391,6 @@ error !; # define XCDR(c) lisp_h_XCDR (c) # define XCONS(a) lisp_h_XCONS (a) # define XHASH(a) lisp_h_XHASH (a) -# define XPNTR(a) lisp_h_XPNTR (a) # ifndef GC_CHECK_CONS_LIST # define check_cons_list() lisp_h_check_cons_list () # endif @@ -411,17 +404,6 @@ error !; # endif #endif -/* Define NAME as a lisp.h inline function that returns TYPE and has - arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and - ARGS should be parenthesized. Implement the function by calling - lisp_h_NAME ARGS. */ -#define LISP_MACRO_DEFUN(name, type, argdecls, args) \ - INLINE type (name) argdecls { return lisp_h_##name args; } - -/* like LISP_MACRO_DEFUN, except NAME returns void. */ -#define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \ - INLINE void (name) argdecls { lisp_h_##name args; } - /* Define the fundamental Lisp data structures. */ @@ -486,6 +468,9 @@ enum Lisp_Misc_Type Lisp_Misc_Overlay, Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, +#ifdef HAVE_MODULES + Lisp_Misc_User_Ptr, +#endif /* Currently floats are not a misc type, but let's define this in case we want to change that. */ Lisp_Misc_Float, @@ -599,6 +584,12 @@ INLINE bool PROCESSP (Lisp_Object); INLINE bool PSEUDOVECTORP (Lisp_Object, int); INLINE bool SAVE_VALUEP (Lisp_Object); INLINE bool FINALIZERP (Lisp_Object); + +#ifdef HAVE_MODULES +INLINE bool USER_PTRP (Lisp_Object); +INLINE struct Lisp_User_Ptr *(XUSER_PTR) (Lisp_Object); +#endif + INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); INLINE bool STRINGP (Lisp_Object); @@ -754,8 +745,18 @@ struct Lisp_Symbol /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. At the machine level, these operations are no-ops. */ -LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) -LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i)) + +INLINE EMACS_INT +(XLI) (Lisp_Object o) +{ + return lisp_h_XLI (o); +} + +INLINE Lisp_Object +(XIL) (EMACS_INT i) +{ + return lisp_h_XIL (i); +} /* In the size word of a vector, this bit means the vector has been marked. */ @@ -831,12 +832,41 @@ DEFINE_GDB_SYMBOL_END (VALMASK) #if USE_LSB_TAG -LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) -LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a)) -LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a)) -LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) -LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) -LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) +INLINE Lisp_Object +(make_number) (EMACS_INT n) +{ + return lisp_h_make_number (n); +} + +INLINE EMACS_INT +(XINT) (Lisp_Object a) +{ + return lisp_h_XINT (a); +} + +INLINE EMACS_INT +(XFASTINT) (Lisp_Object a) +{ + return lisp_h_XFASTINT (a); +} + +INLINE struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ + return lisp_h_XSYMBOL (a); +} + +INLINE enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ + return lisp_h_XTYPE (a); +} + +INLINE void * +(XUNTAG) (Lisp_Object a, int type) +{ + return lisp_h_XUNTAG (a, type); +} #else /* ! USE_LSB_TAG */ @@ -916,9 +946,6 @@ XUNTAG (Lisp_Object a, int type) #endif /* ! USE_LSB_TAG */ -/* Extract the pointer hidden within A. */ -LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) - /* Extract A's value as an unsigned integer. */ INLINE EMACS_UINT XUINT (Lisp_Object a) @@ -930,7 +957,12 @@ XUINT (Lisp_Object a) /* Return A's (Lisp-integer sized) hash. Happens to be like XUINT right now, but XUINT should only be applied to objects we know are integers. */ -LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a)) + +INLINE EMACS_INT +(XHASH) (Lisp_Object a) +{ + return lisp_h_XHASH (a); +} /* Like make_number (N), but may be faster. N must be in nonnegative range. */ INLINE Lisp_Object @@ -942,7 +974,12 @@ make_natnum (EMACS_INT n) } /* Return true if X and Y are the same object. */ -LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y)) + +INLINE bool +(EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_EQ (x, y); +} /* Value is true if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned @@ -960,7 +997,11 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) /* Extract a value or address from a Lisp_Object. */ -LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a)) +INLINE struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + return lisp_h_XCONS (a); +} INLINE struct Lisp_Vector * XVECTOR (Lisp_Object a) @@ -1133,9 +1174,11 @@ make_pointer_integer (void *p) /* Type checking. */ -LISP_MACRO_DEFUN_VOID (CHECK_TYPE, - (int ok, Lisp_Object predicate, Lisp_Object x), - (ok, predicate, x)) +INLINE void +(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x) +{ + lisp_h_CHECK_TYPE (ok, predicate, x); +} /* See the macros in intervals.h. */ @@ -1175,8 +1218,18 @@ xcdr_addr (Lisp_Object c) } /* Use these from normal code. */ -LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c)) -LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c)) + +INLINE Lisp_Object +(XCAR) (Lisp_Object c) +{ + return lisp_h_XCAR (c); +} + +INLINE Lisp_Object +(XCDR) (Lisp_Object c) +{ + return lisp_h_XCDR (c); +} /* Use these to set the fields of a cons cell. @@ -1713,7 +1766,11 @@ verify (offsetof (struct Lisp_Sub_Char_Table, contents) /* Value is name of symbol. */ -LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) +INLINE Lisp_Object +(SYMBOL_VAL) (struct Lisp_Symbol *sym) +{ + return lisp_h_SYMBOL_VAL (sym); +} INLINE struct Lisp_Symbol * SYMBOL_ALIAS (struct Lisp_Symbol *sym) @@ -1734,8 +1791,11 @@ SYMBOL_FWD (struct Lisp_Symbol *sym) return sym->val.fwd; } -LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL, - (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v)) +INLINE void +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +{ + lisp_h_SET_SYMBOL_VAL (sym, v); +} INLINE void SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) @@ -1782,7 +1842,11 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) +INLINE int +(SYMBOL_CONSTANT_P) (Lisp_Object sym) +{ + return lisp_h_SYMBOL_CONSTANT_P (sym); +} /* Placeholder for make-docfile to process. The actual symbol definition is done by lread.c's defsym. */ @@ -2175,6 +2239,18 @@ XSAVE_OBJECT (Lisp_Object obj, int n) return XSAVE_VALUE (obj)->data[n].object; } +#ifdef HAVE_MODULES +struct Lisp_User_Ptr +{ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */ + bool_bf gcmarkbit : 1; + unsigned spacer : 15; + + void (*finalizer) (void*); + void *p; +}; +#endif + /* A finalizer sentinel. */ struct Lisp_Finalizer { @@ -2210,6 +2286,9 @@ union Lisp_Misc struct Lisp_Overlay u_overlay; struct Lisp_Save_Value u_save_value; struct Lisp_Finalizer u_finalizer; +#ifdef HAVE_MODULES + struct Lisp_User_Ptr u_user_ptr; +#endif }; INLINE union Lisp_Misc * @@ -2259,6 +2338,16 @@ XFINALIZER (Lisp_Object a) return & XMISC (a)->u_finalizer; } +#ifdef HAVE_MODULES +INLINE struct Lisp_User_Ptr * +XUSER_PTR (Lisp_Object a) +{ + eassert (USER_PTRP (a)); + return & XMISC (a)->u_user_ptr; +} +#endif + + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2452,7 +2541,11 @@ enum char_bits /* Data type checking. */ -LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x)) +INLINE bool +(NILP) (Lisp_Object x) +{ + return lisp_h_NILP (x); +} INLINE bool NUMBERP (Lisp_Object x) @@ -2476,13 +2569,41 @@ RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ && XINT (x) <= TYPE_MAXIMUM (type)) -LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x)) +INLINE bool +(CONSP) (Lisp_Object x) +{ + return lisp_h_CONSP (x); +} +INLINE bool +(FLOATP) (Lisp_Object x) +{ + return lisp_h_FLOATP (x); +} +INLINE bool +(MISCP) (Lisp_Object x) +{ + return lisp_h_MISCP (x); +} +INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return lisp_h_SYMBOLP (x); +} +INLINE bool +(INTEGERP) (Lisp_Object x) +{ + return lisp_h_INTEGERP (x); +} +INLINE bool +(VECTORLIKEP) (Lisp_Object x) +{ + return lisp_h_VECTORLIKEP (x); +} +INLINE bool +(MARKERP) (Lisp_Object x) +{ + return lisp_h_MARKERP (x); +} INLINE bool STRINGP (Lisp_Object x) @@ -2511,6 +2632,14 @@ FINALIZERP (Lisp_Object x) return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; } +#ifdef HAVE_MODULES +INLINE bool +USER_PTRP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; +} +#endif + INLINE bool AUTOLOADP (Lisp_Object x) { @@ -2633,9 +2762,23 @@ CHECK_LIST (Lisp_Object x) CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); } -LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y)) -LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x)) -LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x)) +INLINE void +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +{ + lisp_h_CHECK_LIST_CONS (x, y); +} + +INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} + +INLINE void +(CHECK_NUMBER) (Lisp_Object x) +{ + lisp_h_CHECK_NUMBER (x); +} INLINE void CHECK_STRING (Lisp_Object x) @@ -3003,7 +3146,9 @@ SPECPDL_INDEX (void) A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch' member is TAG, and then unbinds to it. The `val' member is used to hold VAL while the stack is unwound; `val' is returned as the value - of the catch form. + of the catch form. If there is a handler of type CATCHER_ALL, it will + be treated as a handler for all invocations of `throw'; in this case + `val' will be set to (TAG . VAL). All the other members are concerned with restoring the interpreter state. @@ -3011,7 +3156,7 @@ SPECPDL_INDEX (void) Members are volatile if their values need to survive _longjmp when a 'struct handler' is a local variable. */ -enum handlertype { CATCHER, CONDITION_CASE }; +enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; struct handler { @@ -3041,25 +3186,15 @@ struct handler /* Fill in the components of c, and put it on the list. */ #define PUSH_HANDLER(c, tag_ch_val, handlertype) \ - if (handlerlist->nextfree) \ - (c) = handlerlist->nextfree; \ - else \ - { \ - (c) = xmalloc (sizeof (struct handler)); \ - (c)->nextfree = NULL; \ - handlerlist->nextfree = (c); \ - } \ - (c)->type = (handlertype); \ - (c)->tag_or_ch = (tag_ch_val); \ - (c)->val = Qnil; \ - (c)->next = handlerlist; \ - (c)->lisp_eval_depth = lisp_eval_depth; \ - (c)->pdlcount = SPECPDL_INDEX (); \ - (c)->poll_suppress_count = poll_suppress_count; \ - (c)->interrupt_input_blocked = interrupt_input_blocked;\ - (c)->byte_stack = byte_stack_list; \ - handlerlist = (c); + push_handler(&(c), (tag_ch_val), (handlertype)) +extern void push_handler (struct handler **c, Lisp_Object tag_ch_val, + enum handlertype handlertype); + +/* Like push_handler, but don't signal if the handler could not be + allocated. Instead return false in that case. */ +extern bool push_handler_nosignal (struct handler **c, Lisp_Object tag_ch_val, + enum handlertype handlertype); extern Lisp_Object memory_signal_data; @@ -3244,17 +3379,9 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, #define INTEGER_TO_CONS(i) \ (! FIXNUM_OVERFLOW_P (i) \ ? make_number (i) \ - : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \ - || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \ - && FIXNUM_OVERFLOW_P ((i) >> 16)) \ - ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \ - : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \ - || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \ - && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \ - ? Fcons (make_number ((i) >> 16 >> 24), \ - Fcons (make_number ((i) >> 16 & 0xffffff), \ - make_number ((i) & 0xffff))) \ - : make_float (i)) + : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i)) +extern Lisp_Object intbig_to_lisp (intmax_t); +extern Lisp_Object uintbig_to_lisp (uintmax_t); /* Convert the Emacs representation CONS back to an integer of type TYPE, storing the result the variable VAR. Signal an error if CONS @@ -3314,7 +3441,8 @@ Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); -extern struct hash_table_test hashtest_eql, hashtest_equal; +void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); +extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t *, ptrdiff_t *); extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, @@ -3784,6 +3912,11 @@ Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); extern bool let_shadows_global_binding_p (Lisp_Object symbol); +#ifdef HAVE_MODULES +/* Defined in alloc.c. */ +extern Lisp_Object make_user_ptr (void (*finalizer) (void*), void *p); + +#endif /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); @@ -3915,7 +4048,6 @@ extern void syms_of_casetab (void); extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); -extern Lisp_Object last_undo_boundary; extern bool input_pending; #ifdef HAVE_STACK_OVERFLOW_HANDLING extern sigjmp_buf return_to_command_loop; @@ -4346,40 +4478,24 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); } \ } while (false) - -/* Return floor (NBYTES / WORD_SIZE). */ - -INLINE ptrdiff_t -lisp_word_count (ptrdiff_t nbytes) -{ - if (-1 >> 1 == -1) - switch (word_size + 0) - { - case 2: return nbytes >> 1; - case 4: return nbytes >> 2; - case 8: return nbytes >> 3; - case 16: return nbytes >> 4; - default: break; - } - return nbytes / word_size - (nbytes % word_size < 0); -} - /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */ #define SAFE_ALLOCA_LISP(buf, nelt) \ do { \ - if ((nelt) <= lisp_word_count (sa_avail)) \ - (buf) = AVAIL_ALLOCA ((nelt) * word_size); \ - else if ((nelt) <= min (PTRDIFF_MAX, SIZE_MAX) / word_size) \ + ptrdiff_t alloca_nbytes; \ + if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \ + || SIZE_MAX < alloca_nbytes) \ + memory_full (SIZE_MAX); \ + else if (alloca_nbytes <= sa_avail) \ + (buf) = AVAIL_ALLOCA (alloca_nbytes); \ + else \ { \ Lisp_Object arg_; \ - (buf) = xmalloc ((nelt) * word_size); \ + (buf) = xmalloc (alloca_nbytes); \ arg_ = make_save_memory (buf, nelt); \ sa_must_free = true; \ record_unwind_protect (free_save_value, arg_); \ } \ - else \ - memory_full (SIZE_MAX); \ } while (false)