X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aca9354c01af0625997d60b089289140695e5e91..1a5a05cf6f68277c142fe3753581d3b0c6470156:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index e2b7b67103..6a98adbda9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1,14 +1,14 @@ /* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*- -Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation, +Copyright (C) 1985-1987, 1993-1995, 1997-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -67,19 +67,6 @@ DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS) #define GCTYPEBITS 3 DEFINE_GDB_SYMBOL_END (GCTYPEBITS) -/* The number of bits needed in an EMACS_INT over and above the number - of bits in a pointer. This is 0 on systems where: - 1. We can specify multiple-of-8 alignment on static variables. - 2. We know malloc returns a multiple of 8. */ -#if (defined alignas \ - && (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \ - || defined DARWIN_OS || defined __sun || defined __MINGW32__ \ - || defined CYGWIN)) -# define NONPOINTER_BITS 0 -#else -# define NONPOINTER_BITS GCTYPEBITS -#endif - /* EMACS_INT - signed integer wide enough to hold an Emacs value EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if pI - printf length modifier for EMACS_INT @@ -87,18 +74,16 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS) #ifndef EMACS_INT_MAX # if INTPTR_MAX <= 0 # error "INTPTR_MAX misconfigured" -# elif INTPTR_MAX <= INT_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT +# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT typedef int EMACS_INT; typedef unsigned int EMACS_UINT; # define EMACS_INT_MAX INT_MAX # define pI "" -# elif INTPTR_MAX <= LONG_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT +# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT typedef long int EMACS_INT; typedef unsigned long EMACS_UINT; # define EMACS_INT_MAX LONG_MAX # define pI "l" -/* Check versus LLONG_MAX, not LLONG_MAX >> NONPOINTER_BITS. - In theory this is not safe, but in practice it seems to be OK. */ # elif INTPTR_MAX <= LLONG_MAX typedef long long int EMACS_INT; typedef unsigned long long int EMACS_UINT; @@ -258,7 +243,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)) @@ -277,10 +262,6 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG) error !; #endif -#ifndef alignas -# error "alignas not defined" -#endif - #ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED # define GCALIGNED __attribute__ ((aligned (GCALIGNMENT))) #else @@ -301,10 +282,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 @@ -318,15 +295,7 @@ error !; Bug#11935. Commentary for these macros can be found near their corresponding - functions, below. - - Note: Each use of LISP_MACRO_DEFUN should have a semi-colon ; at - its end, although the expansion of that macro doesn't require that. - That's because any inline function defined immediately after the - use of that macro will otherwise be missed by 'etags' (because - 'etags' works on un-preprocessed source, and treats the invocation - of LISP_MACRO_DEFUN as some kind of data type), and will not end up - in TAGS. */ + functions, below. */ #if CHECK_LISP_OBJECT_TYPE # define lisp_h_XLI(o) ((o).i) @@ -369,7 +338,7 @@ error !; # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) # define lisp_h_XSYMBOL(a) \ (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) ((uintptr_t) XLI (a) - Lisp_Symbol \ + (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \ + (char *) lispsym)) # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) # define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type))) @@ -381,6 +350,12 @@ error !; #if (defined __NO_INLINE__ \ && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ && ! (defined INLINING && ! INLINING)) +# define DEFINE_KEY_OPS_AS_MACROS true +#else +# define DEFINE_KEY_OPS_AS_MACROS false +#endif + +#if DEFINE_KEY_OPS_AS_MACROS # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) # define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) @@ -416,17 +391,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. */ @@ -491,6 +455,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, @@ -604,6 +571,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); @@ -727,9 +700,15 @@ struct Lisp_Symbol #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* Yield an integer that contains TAG along with PTR. */ +/* Yield a signed integer that contains TAG along with PTR. + + Sign-extend pointers when USE_LSB_TAG (this simplifies emacs-module.c), + and zero-extend otherwise (that’s a bit faster here). + Sign extension matters only when EMACS_INT is wider than a pointer. */ #define TAG_PTR(tag, ptr) \ - ((USE_LSB_TAG ? (tag) : (EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)) + (USE_LSB_TAG \ + ? (intptr_t) (ptr) + (tag) \ + : (EMACS_INT) (((EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr))) /* Yield an integer that contains a symbol tag along with OFFSET. OFFSET should be the offset in bytes from 'lispsym' to the symbol. */ @@ -759,8 +738,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. */ @@ -791,6 +780,9 @@ enum pvec_type PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, PVEC_OTHER, + PVEC_XWIDGET, + PVEC_XWIDGET_VIEW, + /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, PVEC_CHAR_TABLE, @@ -836,12 +828,43 @@ 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) +{ + EMACS_INT n = lisp_h_XFASTINT (a); + eassume (0 <= n); + return n; +} + +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 */ @@ -890,19 +913,10 @@ XFASTINT (Lisp_Object a) { EMACS_INT int0 = Lisp_Int0; EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS); - eassert (0 <= n); + eassume (0 <= n); return n; } -/* Extract A's value as a symbol. */ -INLINE struct Lisp_Symbol * -XSYMBOL (Lisp_Object a) -{ - uintptr_t i = (uintptr_t) XUNTAG (a, Lisp_Symbol); - void *p = (char *) lispsym + i; - return p; -} - /* Extract A's type. */ INLINE enum Lisp_Type XTYPE (Lisp_Object a) @@ -911,6 +925,16 @@ XTYPE (Lisp_Object a) return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; } +/* Extract A's value as a symbol. */ +INLINE struct Lisp_Symbol * +XSYMBOL (Lisp_Object a) +{ + eassert (SYMBOLP (a)); + intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol); + void *p = (char *) lispsym + i; + return p; +} + /* Extract A's pointer value, assuming A's type is TYPE. */ INLINE void * XUNTAG (Lisp_Object a, int type) @@ -932,7 +956,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 @@ -944,7 +973,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 @@ -962,7 +996,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) @@ -1135,9 +1173,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. */ @@ -1177,8 +1217,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. @@ -1259,7 +1309,7 @@ STRING_MULTIBYTE (Lisp_Object str) /* Mark STR as a unibyte string. */ #define STRING_SET_UNIBYTE(STR) \ do { \ - if (EQ (STR, empty_multibyte_string)) \ + if (XSTRING (STR)->size == 0) \ (STR) = empty_unibyte_string; \ else \ XSTRING (STR)->size_byte = -1; \ @@ -1269,7 +1319,7 @@ STRING_MULTIBYTE (Lisp_Object str) ASCII characters in advance. */ #define STRING_SET_MULTIBYTE(STR) \ do { \ - if (EQ (STR, empty_unibyte_string)) \ + if (XSTRING (STR)->size == 0) \ (STR) = empty_multibyte_string; \ else \ XSTRING (STR)->size_byte = XSTRING (STR)->size; \ @@ -1485,7 +1535,16 @@ aref_addr (Lisp_Object array, ptrdiff_t idx) INLINE ptrdiff_t ASIZE (Lisp_Object array) { - return XVECTOR (array)->header.size; + ptrdiff_t size = XVECTOR (array)->header.size; + eassume (0 <= size); + return size; +} + +INLINE ptrdiff_t +gc_asize (Lisp_Object array) +{ + /* Like ASIZE, but also can be used in the garbage collector. */ + return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG; } INLINE void @@ -1500,7 +1559,7 @@ 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)); + eassert (0 <= idx && idx < gc_asize (array)); XVECTOR (array)->contents[idx] = val; } @@ -1707,7 +1766,8 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) /* Make sure that sub char-table contents slot is where we think it is. */ verify (offsetof (struct Lisp_Sub_Char_Table, contents) - == offsetof (struct Lisp_Vector, contents[SUB_CHAR_TABLE_OFFSET])); + == (offsetof (struct Lisp_Vector, contents) + + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object))); /*********************************************************************** Symbols @@ -1715,7 +1775,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) @@ -1736,8 +1800,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) @@ -1784,7 +1851,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. */ @@ -1871,21 +1942,22 @@ struct Lisp_Hash_Table }; +INLINE bool +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} + INLINE struct Lisp_Hash_Table * XHASH_TABLE (Lisp_Object a) { + eassert (HASH_TABLE_P (a)); return XUNTAG (a, Lisp_Vectorlike); } #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -INLINE bool -HASH_TABLE_P (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_HASH_TABLE); -} - /* Value is the key part of entry IDX in hash table H. */ INLINE Lisp_Object HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) @@ -2000,7 +2072,7 @@ struct Lisp_Marker /* For markers that point somewhere, this is used to chain of all the markers in a given buffer. */ /* We could remove it and use an array in buffer_text instead. - That would also allow to preserve it ordered. */ + That would also allow us to preserve it ordered. */ struct Lisp_Marker *next; /* This is the char position where the marker points. */ ptrdiff_t charpos; @@ -2177,6 +2249,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 { @@ -2212,6 +2296,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 * @@ -2261,6 +2348,15 @@ 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, @@ -2454,7 +2550,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) @@ -2478,13 +2578,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) @@ -2513,6 +2641,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) { @@ -2635,9 +2771,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) @@ -3005,7 +3155,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. @@ -3013,7 +3165,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,28 +3193,6 @@ struct handler struct byte_stack *byte_stack; }; -/* 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); - - extern Lisp_Object memory_signal_data; /* An address near the bottom of the stack. @@ -3246,17 +3376,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 @@ -3316,7 +3438,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, @@ -3449,6 +3572,7 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, ptrdiff_t *, ptrdiff_t *); /* Defined in alloc.c. */ +extern void *my_heap_start (void); extern void check_pure_size (void); extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); @@ -3460,6 +3584,13 @@ extern void mark_object (Lisp_Object); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif +#ifdef DOUG_LEA_MALLOC +extern void alloc_unexec_pre (void); +extern void alloc_unexec_post (void); +#else +INLINE void alloc_unexec_pre (void) {} +INLINE void alloc_unexec_post (void) {} +#endif extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; extern Lisp_Object *stack_base; @@ -3712,7 +3843,6 @@ intern_c_string (const char *str) } /* Defined in eval.c. */ -extern EMACS_INT lisp_eval_depth; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; @@ -3756,6 +3886,8 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp 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 struct handler *push_handler (Lisp_Object, enum handlertype); +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); extern void record_unwind_protect_ptr (void (*) (void *), void *); @@ -3786,6 +3918,14 @@ 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); + +/* Defined in emacs-module.c. */ +extern void module_init (void); +extern void syms_of_module (void); +#endif /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); @@ -3917,7 +4057,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; @@ -4167,17 +4306,23 @@ extern void init_font (void); extern void syms_of_fontset (void); #endif +/* Defined in inotify.c */ +#ifdef HAVE_INOTIFY +extern void syms_of_inotify (void); +#endif + +/* Defined in kqueue.c */ +#ifdef HAVE_KQUEUE +extern void globals_of_kqueue (void); +extern void syms_of_kqueue (void); +#endif + /* Defined in gfilenotify.c */ #ifdef HAVE_GFILENOTIFY extern void globals_of_gfilenotify (void); extern void syms_of_gfilenotify (void); #endif -/* Defined in inotify.c */ -#ifdef HAVE_INOTIFY -extern void syms_of_inotify (void); -#endif - #ifdef HAVE_W32NOTIFY /* Defined on w32notify.c. */ extern void syms_of_w32notify (void); @@ -4348,40 +4493,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) @@ -4394,6 +4523,12 @@ lisp_word_count (ptrdiff_t nbytes) This feature is experimental and requires careful debugging. Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */ +#if (!defined USE_STACK_LISP_OBJECTS \ + && defined __GNUC__ && !defined __clang__ \ + && !(4 < __GNUC__ + (3 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__)))) + /* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2. */ +# define USE_STACK_LISP_OBJECTS false +#endif #ifndef USE_STACK_LISP_OBJECTS # define USE_STACK_LISP_OBJECTS true #endif