X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f34897e34def565eb6e07461549ab2ba2e275e95..844e0de1bc2bf56118b749f50a4880db7c918fd5:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index 6d397169e8..39dc624bce 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -28,9 +28,9 @@ along with GNU Emacs. If not, see . */ #include #include #include - #include #include +#include INLINE_HEADER_BEGIN @@ -98,29 +98,21 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS) EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if pI - printf length modifier for EMACS_INT EMACS_UINT - unsigned variant of EMACS_INT */ -#ifndef EMACS_INT_MAX -# if INTPTR_MAX <= 0 -# error "INTPTR_MAX misconfigured" -# elif INTPTR_MAX <= INT_MAX >> NONPOINTER_BITS && !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 -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; -# define EMACS_INT_MAX LLONG_MAX -# define pI "ll" -# else -# error "INTPTR_MAX too large" -# endif + +typedef scm_t_signed_bits EMACS_INT; +typedef scm_t_bits EMACS_UINT; +#define EMACS_INT_MAX SCM_T_SIGNED_BITS_MAX + +#if INTPTR_MAX == INT_MAX +#define pI "" +#elif INTPTR_MAX == LONG_MAX +#define pI "l" +#elif INTPTR_MAX == LLONG_MAX +#define pI "ll" +#elif INTPTR_MAX == INTMAX_MAX +#define pI "j" +#else +#error "Cannot determine length modifier for EMACS_INT" #endif /* Number of bits to put in each character in the internal representation @@ -232,64 +224,24 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; #endif /* ENABLE_CHECKING */ -/* Use the configure flag --enable-check-lisp-object-type to make - Lisp_Object use a struct type instead of the default int. The flag - causes CHECK_LISP_OBJECT_TYPE to be defined. */ - -/***** Select the tagging scheme. *****/ -/* The following option controls the tagging scheme: - - USE_LSB_TAG means that we can assume the least 3 bits of pointers are - always 0, and we can thus use them to hold tag bits, without - restricting our addressing space. - - If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus - restricting our possible address range. - - USE_LSB_TAG not only requires the least 3 bits of pointers returned by - malloc to be 0 but also needs to be able to impose a mult-of-8 alignment - on the few static Lisp_Objects used: all the defsubr as well - as the two special buffers buffer_defaults and buffer_local_symbols. */ - enum Lisp_Bits { /* 2**GCTYPEBITS. This must be a macro that expands to a literal integer constant, for MSVC. */ #define GCALIGNMENT 8 - /* Number of bits in a Lisp_Object value, not counting the tag. */ - VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS, - - /* Number of bits in a Lisp fixnum tag. */ - INTTYPEBITS = GCTYPEBITS - 1, - /* Number of bits in a Lisp fixnum value, not counting the tag. */ - FIXNUM_BITS = VALBITS + 1 + FIXNUM_BITS = SCM_I_FIXNUM_BIT }; #if GCALIGNMENT != 1 << GCTYPEBITS # error "GCALIGNMENT and GCTYPEBITS are inconsistent" #endif -/* 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 VAL_MAX < UINTPTR_MAX' below. */ -#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1)) - -/* Whether the least-significant bits of an EMACS_INT contain the tag. - On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is: - a. unnecessary, because the top bits of an EMACS_INT are unused, and - b. slower, because it typically requires extra masking. - So, USE_LSB_TAG is true only on hosts where it might be useful. */ DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG) -#define USE_LSB_TAG (EMACS_INT_MAX >> GCTYPEBITS < INTPTR_MAX) +#define USE_LSB_TAG 1 DEFINE_GDB_SYMBOL_END (USE_LSB_TAG) -#if !USE_LSB_TAG && !defined WIDE_EMACS_INT -# error "USE_LSB_TAG not supported on this platform; please report this." \ - "Try 'configure --with-wide-int' to work around the problem." -error !; -#endif - #ifndef alignas # define alignas(alignment) /* empty */ # if USE_LSB_TAG @@ -297,7 +249,6 @@ error !; # endif #endif - /* Some operations are so commonly executed that they are implemented as macros, not functions, because otherwise runtime performance would suffer too much when compiling with GCC without optimization. @@ -331,93 +282,35 @@ error !; Commentary for these macros can be found near their corresponding functions, below. */ -#if CHECK_LISP_OBJECT_TYPE -# define lisp_h_XLI(o) ((o).i) -# define lisp_h_XIL(i) ((Lisp_Object) { i }) -#else -# define lisp_h_XLI(o) (o) -# define lisp_h_XIL(i) (i) -#endif +#define SMOB_PTR(a) ((void *) SCM_SMOB_DATA (a)) +#define SMOB_TYPEP(x, tag) (x && SCM_SMOB_PREDICATE (tag, x)) +#define lisp_h_XLI(o) (SCM_UNPACK (o)) +#define lisp_h_XIL(i) (SCM_PACK (i)) #define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) -#define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \ - ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x)) -#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) -#define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) -#define lisp_h_INTEGERP(x) ((XTYPE (x) & ~Lisp_Int1) == 0) +#define lisp_h_CHECK_TYPE(ok, predicate, x) \ + ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x)) +#define lisp_h_CONSP(x) (x && scm_is_pair (x)) +#define lisp_h_EQ(x, y) (scm_is_eq (x, y)) +#define lisp_h_FLOATP(x) (x && SCM_INEXACTP (x)) +#define lisp_h_INTEGERP(x) (SCM_I_INUMP (x)) #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) -#define lisp_h_NILP(x) EQ (x, Qnil) +#define lisp_h_MISCP(x) (SMOB_TYPEP (x, lisp_misc_tag)) +#define lisp_h_NILP(x) (scm_is_lisp_false (x)) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) + (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \ + scm_c_vector_set_x (sym, 4, v)) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYMBOL_CONSTANT (XSYMBOL (sym))) #define lisp_h_SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) -#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) -#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) -#define lisp_h_XCAR(c) XCONS (c)->car -#define lisp_h_XCDR(c) XCONS (c)->u.cdr -#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) ((void *) (intptr_t) (XLI (a) & VALMASK)) -#define lisp_h_XSYMBOL(a) \ - (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#ifndef GC_CHECK_CONS_LIST -# define lisp_h_check_cons_list() ((void) 0) -#endif -#if USE_LSB_TAG -# define lisp_h_make_number(n) \ - XIL ((EMACS_INT) ((EMACS_UINT) (n) << INTTYPEBITS)) -# define lisp_h_XFASTINT(a) XINT (a) -# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) -# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) -# define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type))) -#endif - -/* When compiling via gcc -O0, define the key operations as macros, as - Emacs is too slow otherwise. To disable this optimization, compile - with -DINLINING=false. */ -#if (defined __NO_INLINE__ \ - && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ - && ! (defined INLINING && ! INLINING)) -# 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) -# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) -# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) -# define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x) -# define CONSP(x) lisp_h_CONSP (x) -# define EQ(x, y) lisp_h_EQ (x, y) -# define FLOATP(x) lisp_h_FLOATP (x) -# define INTEGERP(x) lisp_h_INTEGERP (x) -# define MARKERP(x) lisp_h_MARKERP (x) -# define MISCP(x) lisp_h_MISCP (x) -# define NILP(x) lisp_h_NILP (x) -# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) -# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) -# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -# define SYMBOLP(x) lisp_h_SYMBOLP (x) -# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) -# define XCAR(c) lisp_h_XCAR (c) -# 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) -# define XSYMBOL(a) lisp_h_XSYMBOL (a) -# ifndef GC_CHECK_CONS_LIST -# define check_cons_list() lisp_h_check_cons_list () -# endif -# if USE_LSB_TAG -# define make_number(n) lisp_h_make_number (n) -# define XFASTINT(a) lisp_h_XFASTINT (a) -# define XINT(a) lisp_h_XINT (a) -# define XTYPE(a) lisp_h_XTYPE (a) -# define XUNTAG(a, type) lisp_h_XUNTAG (a, type) -# endif -#endif + (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \ + scm_c_vector_ref (sym, 4)) +#define lisp_h_SYMBOLP(x) \ + (x && (scm_is_symbol (x) || EQ (x, Qnil) || EQ (x, Qt))) +#define lisp_h_VECTORLIKEP(x) (SMOB_TYPEP (x, lisp_vectorlike_tag)) +#define lisp_h_XCAR(c) (scm_car (c)) +#define lisp_h_XCDR(c) (scm_cdr (c)) +#define lisp_h_XHASH(a) (SCM_UNPACK (a)) /* Define NAME as a lisp.h inline function that returns TYPE and has arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and @@ -437,10 +330,8 @@ error !; data type, read the comments after Lisp_Fwd_Type definition below. */ -/* Lisp integers use 2 tags, to give them one extra bit, thus - extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ -#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) -#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 +#define INTMASK SCM_MOST_POSITIVE_FIXNUM +#define case_Lisp_Int case Lisp_Int /* Idea stolen from GDB. Pedantic GCC complains about enum bitfields, MSVC doesn't support them, and xlc and Oracle Studio c99 complain @@ -452,34 +343,38 @@ error !; #define ENUM_BF(TYPE) enum TYPE #endif +scm_t_bits lisp_misc_tag; +scm_t_bits lisp_string_tag; +scm_t_bits lisp_vectorlike_tag; enum Lisp_Type { + Lisp_Other, + /* Integer. XINT (obj) is the integer value. */ - Lisp_Int0 = 0, - Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1, + Lisp_Int, /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ - Lisp_Symbol = 2, + Lisp_Symbol, /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, whose first member indicates the subtype. */ - Lisp_Misc = 3, + Lisp_Misc, /* String. XSTRING (object) points to a struct Lisp_String. The length of the string, and its contents, are stored therein. */ - Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS, + Lisp_String, /* Vector of Lisp objects, or something resembling it. XVECTOR (object) points to a struct Lisp_Vector, which contains the size and contents. The size field also contains the type information, if it's not a real vector object. */ - Lisp_Vectorlike = 5, + Lisp_Vectorlike, /* Cons. XCONS (object) points to a struct Lisp_Cons. */ - Lisp_Cons = 6, + Lisp_Cons, - Lisp_Float = 7 + Lisp_Float }; /* This is the set of data types that share a common structure. @@ -512,93 +407,15 @@ enum Lisp_Fwd_Type Lisp_Fwd_Kboard_Obj /* Fwd to a Lisp_Object field of kboards. */ }; -/* If you want to define a new Lisp data type, here are some - instructions. See the thread at - http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00561.html - for more info. - - First, there are already a couple of Lisp types that can be used if - your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Save_Value, a Lisp_Misc - subtype; and PVEC_OTHER, a kind of vectorlike object. The former - is suitable for temporarily stashing away pointers and integers in - a Lisp object. The latter is useful for vector-like Lisp objects - that need to be used as part of other objects, but which are never - shown to users or Lisp code (search for PVEC_OTHER in xterm.c for - an example). - - These two types don't look pretty when printed, so they are - unsuitable for Lisp objects that can be exposed to users. - - To define a new data type, add one more Lisp_Misc subtype or one - more pseudovector subtype. Pseudovectors are more suitable for - objects with several slots that need to support fast random access, - while Lisp_Misc types are for everything else. A pseudovector object - provides one or more slots for Lisp objects, followed by struct - members that are accessible only from C. A Lisp_Misc object is a - wrapper for a C struct that can contain anything you like. - - Explicit freeing is discouraged for Lisp objects in general. But if - you really need to exploit this, use Lisp_Misc (check free_misc in - alloc.c to see why). There is no way to free a vectorlike object. - - To add a new pseudovector type, extend the pvec_type enumeration; - to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. - - For a Lisp_Misc, you will also need to add your entry to union - Lisp_Misc (but make sure the first word has the same structure as - the others, starting with a 16-bit member of the Lisp_Misc_Type - enumeration and a 1-bit GC markbit) and make sure the overall size - of the union is not increased by your addition. - - For a new pseudovector, it's highly desirable to limit the size - of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c). - Otherwise you will need to change sweep_vectors (also in alloc.c). - - Then you will need to add switch branches in print.c (in - print_object, to print your object, and possibly also in - print_preprocess) and to alloc.c, to mark your object (in - mark_object) and to free it (in gc_sweep). The latter is also the - right place to call any code specific to your data type that needs - to run when the object is recycled -- e.g., free any additional - resources allocated for it that are not Lisp objects. You can even - make a pointer to the function that frees the resources a slot in - your object -- this way, the same object could be used to represent - several disparate C structures. */ - -#ifdef CHECK_LISP_OBJECT_TYPE - -typedef struct { EMACS_INT i; } Lisp_Object; - -#define LISP_INITIALLY_ZERO {0} - -#undef CHECK_LISP_OBJECT_TYPE -enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; -#else /* CHECK_LISP_OBJECT_TYPE */ - -/* If a struct type is not wanted, define Lisp_Object as just a number. */ - -typedef EMACS_INT Lisp_Object; -#define LISP_INITIALLY_ZERO 0 -enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; -#endif /* CHECK_LISP_OBJECT_TYPE */ +typedef SCM Lisp_Object; + +#define LISP_INITIALLY_ZERO SCM_INUM0 /* 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)) -/* In the size word of a vector, this bit means the vector has been marked. */ - -#define ARRAY_MARK_FLAG_val PTRDIFF_MIN -#if ENUMABLE (ARRAY_MARK_FLAG_val) -DEFINE_GDB_SYMBOL_ENUM (ARRAY_MARK_FLAG) -#else -DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG) -# define ARRAY_MARK_FLAG ARRAY_MARK_FLAG_val -DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG) -#endif - /* In the size word of a struct Lisp_Vector, this bit means it's really some other vector-like object. */ #define PSEUDOVECTOR_FLAG_val (PTRDIFF_MAX - PTRDIFF_MAX / 2) @@ -625,7 +442,6 @@ enum pvec_type PVEC_HASH_TABLE, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, - PVEC_SUBR, PVEC_OTHER, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, @@ -660,64 +476,24 @@ enum More_Lisp_Bits XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -/* Mask for the value (as opposed to the type bits) of a Lisp object. */ -#define VALMASK_val (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) -#if ENUMABLE (VALMASK_val) -DEFINE_GDB_SYMBOL_ENUM (VALMASK) -#else -DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK) -# define VALMASK VALMASK_val -DEFINE_GDB_SYMBOL_END (VALMASK) -#endif - /* Largest and smallest representable fixnum values. These are the C values. They are macros for use in static initializers. */ -#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) -#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) - -/* Extract the pointer hidden within A. */ -LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) - -#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 (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) -LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) - -#else /* ! USE_LSB_TAG */ - -/* Although compiled only if ! USE_LSB_TAG, the following functions - also work when USE_LSB_TAG; this is to aid future maintenance when - the lisp_h_* macros are eventually removed. */ +#define MOST_POSITIVE_FIXNUM SCM_MOST_POSITIVE_FIXNUM +#define MOST_NEGATIVE_FIXNUM SCM_MOST_NEGATIVE_FIXNUM /* Make a Lisp integer representing the value of the low order bits of N. */ INLINE Lisp_Object make_number (EMACS_INT n) { - if (USE_LSB_TAG) - { - EMACS_UINT u = n; - n = u << INTTYPEBITS; - } - else - n &= INTMASK; - return XIL (n); + return SCM_I_MAKINUM (n); } /* Extract A's value as a signed integer. */ INLINE EMACS_INT XINT (Lisp_Object a) { - EMACS_INT i = XLI (a); - if (! USE_LSB_TAG) - { - EMACS_UINT u = i; - i = u << INTTYPEBITS; - } - return i >> INTTYPEBITS; + return SCM_I_INUM (a); } /* Like XINT (A), but may be faster. A must be nonnegative. @@ -726,39 +502,16 @@ XINT (Lisp_Object a) INLINE EMACS_INT XFASTINT (Lisp_Object a) { - EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a); + EMACS_INT n = XINT (a); eassert (0 <= n); return n; } -/* Extract A's type. */ -INLINE enum Lisp_Type -XTYPE (Lisp_Object a) -{ - EMACS_UINT i = XLI (a); - return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; -} - -/* Extract A's pointer value, assuming A's type is TYPE. */ -INLINE void * -XUNTAG (Lisp_Object a, int type) -{ - if (USE_LSB_TAG) - { - intptr_t i = XLI (a) - type; - return (void *) i; - } - return XPNTR (a); -} - -#endif /* ! USE_LSB_TAG */ - /* Extract A's value as an unsigned integer. */ INLINE EMACS_UINT XUINT (Lisp_Object a) { - EMACS_UINT i = XLI (a); - return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; + return SCM_I_INUM (a); } /* Return A's (Lisp-integer sized) hash. Happens to be like XUINT @@ -771,7 +524,7 @@ INLINE Lisp_Object make_natnum (EMACS_INT n) { eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); - return USE_LSB_TAG ? make_number (n) : XIL (n); + return make_number (n); } /* Return true if X and Y are the same object. */ @@ -814,7 +567,6 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); INLINE bool STRINGP (Lisp_Object); INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); -INLINE bool SUBRP (Lisp_Object); INLINE bool (SYMBOLP) (Lisp_Object); INLINE bool (VECTORLIKEP) (Lisp_Object); INLINE bool WINDOWP (Lisp_Object); @@ -832,12 +584,13 @@ extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp; extern Lisp_Object Qbool_vector_p; extern Lisp_Object Qvector_or_char_table_p, Qwholenump; extern Lisp_Object Qwindow; -extern Lisp_Object Ffboundp (Lisp_Object); extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); /* Defined in emacs.c. */ -extern bool initialized; extern bool might_dump; +/* True means Emacs has already been initialized. + Used during startup to detect startup of dumped Emacs. */ +extern bool initialized; /* Defined in eval.c. */ extern Lisp_Object Qautoload; @@ -854,32 +607,62 @@ extern Lisp_Object Qwindowp; /* Defined in xdisp.c. */ extern Lisp_Object Qimage; +/* Extract A's type. */ +INLINE enum Lisp_Type +XTYPE (Lisp_Object o) +{ + if (INTEGERP (o)) + return Lisp_Int; + else if (SYMBOLP (o)) + return Lisp_Symbol; + else if (MISCP (o)) + return Lisp_Misc; + else if (STRINGP (o)) + return Lisp_String; + else if (VECTORLIKEP (o)) + return Lisp_Vectorlike; + else if (CONSP (o)) + return Lisp_Cons; + else if (FLOATP (o)) + return Lisp_Float; + else + return Lisp_Other; +} /* Extract a value or address from a Lisp_Object. */ -LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a)) - INLINE struct Lisp_Vector * XVECTOR (Lisp_Object a) { eassert (VECTORLIKEP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct Lisp_String * XSTRING (Lisp_Object a) { eassert (STRINGP (a)); - return XUNTAG (a, Lisp_String); + return SMOB_PTR (a); } -LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) +extern void initialize_symbol (Lisp_Object, Lisp_Object); +INLINE Lisp_Object build_string (const char *); +extern Lisp_Object symbol_module; +extern Lisp_Object function_module; +extern Lisp_Object plist_module; +extern Lisp_Object Qt, Qnil, Qt_, Qnil_; + +typedef Lisp_Object sym_t; -INLINE struct Lisp_Float * -XFLOAT (Lisp_Object a) +INLINE sym_t +XSYMBOL (Lisp_Object a) { - eassert (FLOATP (a)); - return XUNTAG (a, Lisp_Float); + Lisp_Object tem; + if (EQ (a, Qt)) a = Qt_; + if (EQ (a, Qnil)) a = Qnil_; + eassert (SYMBOLP (a)); + tem = scm_variable_ref (scm_module_lookup (symbol_module, a)); + return tem; } /* Pseudovector types. */ @@ -888,83 +671,62 @@ INLINE struct Lisp_Process * XPROCESS (Lisp_Object a) { eassert (PROCESSP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct window * XWINDOW (Lisp_Object a) { eassert (WINDOWP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct terminal * XTERMINAL (Lisp_Object a) { - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_Subr * -XSUBR (Lisp_Object a) -{ - eassert (SUBRP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct buffer * XBUFFER (Lisp_Object a) { eassert (BUFFERP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct Lisp_Char_Table * XCHAR_TABLE (Lisp_Object a) { eassert (CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct Lisp_Sub_Char_Table * XSUB_CHAR_TABLE (Lisp_Object a) { eassert (SUB_CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } INLINE struct Lisp_Bool_Vector * XBOOL_VECTOR (Lisp_Object a) { eassert (BOOL_VECTOR_P (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -/* Construct a Lisp_Object from a value or address. */ - -INLINE Lisp_Object -make_lisp_ptr (void *ptr, enum Lisp_Type type) -{ - EMACS_UINT utype = type; - EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS; - Lisp_Object a = XIL (typebits | (uintptr_t) ptr); - eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); - return a; + return SMOB_PTR (a); } INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) { - return make_lisp_ptr (p, Lisp_Vectorlike); + return scm_new_smob (lisp_vectorlike_tag, (scm_t_bits) p); } #define XSETINT(a, b) ((a) = make_number (b)) #define XSETFASTINT(a, b) ((a) = make_natnum (b)) -#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) -#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) -#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) -#define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol)) -#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) -#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) +#define XSETVECTOR(a, b) ((a) = (b)->header.self) +#define XSETSTRING(a, b) ((a) = (b)->self) +#define XSETSYMBOL(a, b) ((a) = scm_c_vector_ref (b, 0)) +#define XSETMISC(a, b) (a) = ((union Lisp_Misc *) (b))->u_any.self /* Pseudovector types. */ @@ -980,7 +742,7 @@ make_lisp_proc (struct Lisp_Process *p) #define XSETPSEUDOVECTOR(a, b, code) \ XSETTYPED_PSEUDOVECTOR (a, b, \ (((struct vectorlike_header *) \ - XUNTAG (a, Lisp_Vectorlike)) \ + SCM_SMOB_DATA (a)) \ ->size), \ code) #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \ @@ -1002,8 +764,9 @@ make_lisp_proc (struct Lisp_Process *p) /* Type checking. */ -LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), - (ok, Qxxxp, x)) +LISP_MACRO_DEFUN_VOID (CHECK_TYPE, + (int ok, Lisp_Object predicate, Lisp_Object x), + (ok, predicate, x)) /* Deprecated and will be removed soon. */ @@ -1013,40 +776,6 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), typedef struct interval *INTERVAL; -struct Lisp_Cons - { - /* 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; - }; - -/* Take the car or cdr of something known to be a cons cell. */ -/* The _addr functions shouldn't be used outside of the minimal set - of code that has to know what a cons cell looks like. Other code not - part of the basic lisp implementation should assume that the car and cdr - fields are not accessible. (What if we want to switch to - a copying collector someday? Cached cons cell field addresses may be - invalidated at arbitrary points.) */ -INLINE Lisp_Object * -xcar_addr (Lisp_Object c) -{ - return &XCONS (c)->car; -} -INLINE Lisp_Object * -xcdr_addr (Lisp_Object c) -{ - return &XCONS (c)->u.cdr; -} - -/* 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)) @@ -1057,12 +786,12 @@ LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c)) INLINE void XSETCAR (Lisp_Object c, Lisp_Object n) { - *xcar_addr (c) = n; + scm_set_car_x (c, n); } INLINE void XSETCDR (Lisp_Object c, Lisp_Object n) { - *xcdr_addr (c) = n; + scm_set_cdr_x (c, n); } /* Take the car or cdr of something whose type is not known. */ @@ -1097,6 +826,7 @@ CDR_SAFE (Lisp_Object c) struct Lisp_String { + Lisp_Object self; ptrdiff_t size; ptrdiff_t size_byte; INTERVAL intervals; /* Text properties in this string. */ @@ -1174,17 +904,10 @@ SCHARS (Lisp_Object string) return XSTRING (string)->size; } -#ifdef GC_CHECK_STRING_BYTES -extern ptrdiff_t string_bytes (struct Lisp_String *); -#endif INLINE ptrdiff_t STRING_BYTES (struct Lisp_String *s) { -#ifdef GC_CHECK_STRING_BYTES - return string_bytes (s); -#else return s->size_byte < 0 ? s->size : s->size_byte; -#endif } INLINE ptrdiff_t @@ -1197,12 +920,6 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) { XSTRING (string)->size = newsize; } -INLINE void -STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, - ptrdiff_t count) -{ - memcpy (SDATA (string) + index, new, count); -} /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents @@ -1213,9 +930,10 @@ STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, Bug#8546. */ struct vectorlike_header { - /* The only field contains various pieces of information: - - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain + Lisp_Object self; + + /* This field contains various pieces of information: + - The second bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain vector (0) or a pseudovector (1). - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number of slots) of the vector. @@ -1376,7 +1094,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 < (ASIZE (array))); XVECTOR (array)->contents[idx] = val; } @@ -1517,32 +1235,6 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) char_table_set (ct, idx, val); } -/* This structure describes a built-in function. - It is generated by the DEFUN macro only. - defsubr makes it into a Lisp object. */ - -struct Lisp_Subr - { - struct vectorlike_header header; - union { - Lisp_Object (*a0) (void); - Lisp_Object (*a1) (Lisp_Object); - Lisp_Object (*a2) (Lisp_Object, Lisp_Object); - Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); - Lisp_Object (*aUNEVALLED) (Lisp_Object args); - Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *); - } function; - short min_args, max_args; - const char *symbol_name; - const char *intspec; - const char *doc; - }; - /* This is the number of slots that every char table must have. This counts the ordinary slots and the top, defalt, parent, and purpose slots. */ @@ -1565,15 +1257,6 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) Symbols ***********************************************************************/ -/* Interned state of a symbol. */ - -enum symbol_interned -{ - SYMBOL_UNINTERNED = 0, - SYMBOL_INTERNED = 1, - SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 -}; - enum symbol_redirect { SYMBOL_PLAINVAL = 4, @@ -1584,102 +1267,92 @@ enum symbol_redirect struct Lisp_Symbol { - bool_bf gcmarkbit : 1; + Lisp_Object self_; /* Indicates where the value can be found: 0 : it's a plain var, the value is in the `value' field. 1 : it's a varalias, the value is really in the `alias' symbol. 2 : it's a localized var, the value is in the `blv' object. 3 : it's a forwarding variable, the value is in `forward'. */ - ENUM_BF (symbol_redirect) redirect : 3; + ENUM_BF (symbol_redirect) redirect_ : 3; /* Non-zero means symbol is constant, i.e. changing its value should signal an error. If the value is 3, then the var can be changed, but only by `defconst'. */ - unsigned constant : 2; - - /* Interned state of the symbol. This is an enumerator from - enum symbol_interned. */ - unsigned interned : 2; + unsigned constant_ : 2; /* True means that this variable has been explicitly declared special (with `defvar' etc), and shouldn't be lexically bound. */ - bool_bf declared_special : 1; - - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - - /* The symbol's name, as a Lisp string. */ - Lisp_Object name; + bool_bf declared_special_ : 1; /* Value of the symbol or Qunbound if unbound. Which alternative of the union is used depends on the `redirect' field above. */ union { - Lisp_Object value; - struct Lisp_Symbol *alias; - struct Lisp_Buffer_Local_Value *blv; - union Lisp_Fwd *fwd; - } val; - - /* Function value of the symbol or Qnil if not fboundp. */ - Lisp_Object function; - - /* The symbol's property list. */ - Lisp_Object plist; - - /* Next symbol in obarray bucket, if the symbol is interned. */ - struct Lisp_Symbol *next; + Lisp_Object value_; + sym_t alias_; + struct Lisp_Buffer_Local_Value *blv_; + union Lisp_Fwd *fwd_; + }; }; -/* Value is name of symbol. */ +#define SYMBOL_SELF(sym) (scm_c_vector_ref (sym, 0)) +#define SET_SYMBOL_SELF(sym, v) (scm_c_vector_set_x (sym, 0, v)) +#define SYMBOL_REDIRECT(sym) (XINT (scm_c_vector_ref (sym, 1))) +#define SET_SYMBOL_REDIRECT(sym, v) (scm_c_vector_set_x (sym, 1, make_number (v))) +#define SYMBOL_CONSTANT(sym) (XINT (scm_c_vector_ref (sym, 2))) +#define SET_SYMBOL_CONSTANT(sym, v) (scm_c_vector_set_x (sym, 2, make_number (v))) +#define SYMBOL_DECLARED_SPECIAL(sym) (XINT (scm_c_vector_ref (sym, 3))) +#define SET_SYMBOL_DECLARED_SPECIAL(sym, v) (scm_c_vector_set_x (sym, 3, make_number (v))) -LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) +/* Value is name of symbol. */ -INLINE struct Lisp_Symbol * -SYMBOL_ALIAS (struct Lisp_Symbol *sym) +INLINE sym_t +SYMBOL_ALIAS (sym_t sym) { - eassert (sym->redirect == SYMBOL_VARALIAS); - return sym->val.alias; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS); + return scm_c_vector_ref (sym, 4); } INLINE struct Lisp_Buffer_Local_Value * -SYMBOL_BLV (struct Lisp_Symbol *sym) +SYMBOL_BLV (sym_t sym) { - eassert (sym->redirect == SYMBOL_LOCALIZED); - return sym->val.blv; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED); + return scm_to_pointer (scm_c_vector_ref (sym, 4)); } INLINE union Lisp_Fwd * -SYMBOL_FWD (struct Lisp_Symbol *sym) +SYMBOL_FWD (sym_t sym) { - eassert (sym->redirect == SYMBOL_FORWARDED); - return sym->val.fwd; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED); + return scm_to_pointer (scm_c_vector_ref (sym, 4)); } LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL, - (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v)) + (sym_t sym, Lisp_Object v), (sym, v)) INLINE void -SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +SET_SYMBOL_ALIAS (sym_t sym, sym_t v) { - eassert (sym->redirect == SYMBOL_VARALIAS); - sym->val.alias = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS); + scm_c_vector_set_x (sym, 4, v); } INLINE void -SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +SET_SYMBOL_BLV (sym_t sym, struct Lisp_Buffer_Local_Value *v) { - eassert (sym->redirect == SYMBOL_LOCALIZED); - sym->val.blv = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED); + scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL)); } INLINE void -SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +SET_SYMBOL_FWD (sym_t sym, union Lisp_Fwd *v) { - eassert (sym->redirect == SYMBOL_FORWARDED); - sym->val.fwd = v; + eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED); + scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL)); } INLINE Lisp_Object SYMBOL_NAME (Lisp_Object sym) { - return XSYMBOL (sym)->name; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return build_string (scm_to_locale_string (scm_symbol_to_string (sym))); } /* Value is true if SYM is an interned symbol. */ @@ -1687,15 +1360,17 @@ SYMBOL_NAME (Lisp_Object sym) INLINE bool SYMBOL_INTERNED_P (Lisp_Object sym) { - return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return scm_is_true (scm_symbol_interned_p (sym)); } -/* Value is true if SYM is interned in initial_obarray. */ - -INLINE bool -SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +INLINE Lisp_Object +SYMBOL_FUNCTION (Lisp_Object sym) { - return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return scm_variable_ref (scm_module_lookup (function_module, sym)); } /* Value is non-zero if symbol is considered a constant, i.e. its @@ -1707,6 +1382,8 @@ LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false) +LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (sym_t sym), (sym)) + /*********************************************************************** Hash Tables @@ -1791,7 +1468,7 @@ struct Lisp_Hash_Table INLINE struct Lisp_Hash_Table * XHASH_TABLE (Lisp_Object a) { - return XUNTAG (a, Lisp_Vectorlike); + return SMOB_PTR (a); } #define XSET_HASH_TABLE(VAR, PTR) \ @@ -1875,23 +1552,21 @@ sxhash_combine (EMACS_UINT x, EMACS_UINT y) INLINE EMACS_UINT SXHASH_REDUCE (EMACS_UINT x) { - return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS)) & INTMASK; + return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS + 1)) & INTMASK; } /* These structures are used for various misc types. */ struct Lisp_Misc_Any /* Supertype of all Misc types. */ { + Lisp_Object self; ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; }; struct Lisp_Marker { + Lisp_Object self; ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ - bool_bf gcmarkbit : 1; - unsigned spacer : 13; /* This flag is temporarily used in the functions decode/encode_coding_object to record that the marker position must be adjusted after the conversion. */ @@ -1943,9 +1618,8 @@ struct Lisp_Overlay I.e. 9words plus 2 bits, 3words of which are for external linked lists. */ { + Lisp_Object self; ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; struct Lisp_Overlay *next; Lisp_Object start; Lisp_Object end; @@ -2021,9 +1695,9 @@ typedef void (*voidfuncptr) (void); struct Lisp_Save_Value { + Lisp_Object self; ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ - bool_bf gcmarkbit : 1; - unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); + unsigned spacer : 32 - (16 + SAVE_TYPE_BITS); /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of V's data entries are determined by V->save_type. E.g., if @@ -2094,22 +1768,12 @@ XSAVE_OBJECT (Lisp_Object obj, int n) return XSAVE_VALUE (obj)->data[n].object; } -/* A miscellaneous object, when it's on the free list. */ -struct Lisp_Free - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - union Lisp_Misc *chain; - }; - /* To get the type field of a union Lisp_Misc, use XMISCTYPE. It uses one of these struct subtypes to get the type field. */ union Lisp_Misc { struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ - struct Lisp_Free u_free; struct Lisp_Marker u_marker; struct Lisp_Overlay u_overlay; struct Lisp_Save_Value u_save_value; @@ -2118,7 +1782,7 @@ union Lisp_Misc INLINE union Lisp_Misc * XMISC (Lisp_Object a) { - return XUNTAG (a, Lisp_Misc); + return SMOB_PTR (a); } INLINE struct Lisp_Misc_Any * @@ -2275,21 +1939,7 @@ XBUFFER_OBJFWD (union Lisp_Fwd *a) return &a->u_buffer_objfwd; } -/* Lisp floating point type. */ -struct Lisp_Float - { - union - { - double data; - struct Lisp_Float *chain; - } u; - }; - -INLINE double -XFLOAT_DATA (Lisp_Object f) -{ - return XFLOAT (f)->u.data; -} +#define XFLOAT_DATA(f) (scm_to_double (f)) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on @@ -2382,7 +2032,7 @@ LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x)) INLINE bool STRINGP (Lisp_Object x) { - return XTYPE (x) == Lisp_String; + return SMOB_TYPEP (x, lisp_string_tag); } INLINE bool VECTORP (Lisp_Object x) @@ -2428,12 +2078,11 @@ PSEUDOVECTORP (Lisp_Object a, int code) else { /* Converting to struct vectorlike_header * avoids aliasing issues. */ - struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + struct vectorlike_header *h = SMOB_PTR (a); return PSEUDOVECTOR_TYPEP (h, code); } } - /* Test for specific pseudovector types. */ INLINE bool @@ -2460,12 +2109,6 @@ TERMINALP (Lisp_Object a) return PSEUDOVECTORP (a, PVEC_TERMINAL); } -INLINE bool -SUBRP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_SUBR); -} - INLINE bool COMPILEDP (Lisp_Object a) { @@ -2557,9 +2200,9 @@ CHECK_VECTOR_OR_STRING (Lisp_Object x) CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); } INLINE void -CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate) { - CHECK_TYPE (ARRAYP (x), Qxxxp, x); + CHECK_TYPE (ARRAYP (x), predicate, x); } INLINE void CHECK_BUFFER (Lisp_Object x) @@ -2676,24 +2319,71 @@ CHECK_NUMBER_CDR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#ifdef _MSC_VER #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ + SCM_SNARF_INIT (defsubr (lname, gsubr_ ## fnname, minargs, maxargs, intspec)) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ - | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ - { (Lisp_Object (__cdecl *)(void))fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ + DEFUN_GSUBR_ ## maxargs (lname, fnname, minargs, maxargs) \ Lisp_Object fnname -#else /* not _MSC_VER */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ - Lisp_Object fnname -#endif + +#define GSUBR_ARGS_1(f) f (arg1) +#define GSUBR_ARGS_2(f) GSUBR_ARGS_1 (f), f (arg2) +#define GSUBR_ARGS_3(f) GSUBR_ARGS_2 (f), f (arg3) +#define GSUBR_ARGS_4(f) GSUBR_ARGS_3 (f), f (arg4) +#define GSUBR_ARGS_5(f) GSUBR_ARGS_4 (f), f (arg5) +#define GSUBR_ARGS_6(f) GSUBR_ARGS_5 (f), f (arg6) +#define GSUBR_ARGS_7(f) GSUBR_ARGS_6 (f), f (arg7) +#define GSUBR_ARGS_8(f) GSUBR_ARGS_7 (f), f (arg8) + +#define GSUBR_ARGS(n) GSUBR_ARGS_PASTE (GSUBR_ARGS_, n) +#define GSUBR_ARGS_PASTE(a, b) a ## b + +#define DEFUN_GSUBR_N(fn, maxargs) \ + Lisp_Object \ + gsubr_ ## fn \ + (GSUBR_ARGS (maxargs) (Lisp_Object)) \ + { \ + return fn (GSUBR_ARGS (maxargs) (GSUBR_ARG)); \ + } +#define GSUBR_ARG(x) (SCM_UNBNDP (x) ? Qnil : x) + +#define DEFUN_GSUBR_0(lname, fn, minargs, maxargs) \ + Lisp_Object gsubr_ ## fn (void) { return fn (); } +#define DEFUN_GSUBR_1(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_2(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_3(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_4(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_5(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_6(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_7(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) +#define DEFUN_GSUBR_8(lname, fn, min, max) DEFUN_GSUBR_N(fn, max) + +#define DEFUN_GSUBR_UNEVALLED(lname, fn, minargs, maxargs) \ + Lisp_Object \ + gsubr_ ## fn (Lisp_Object rest) \ + { \ + Lisp_Object len = Flength (rest); \ + if (XINT (len) < minargs) \ + xsignal2 (Qwrong_number_of_arguments, \ + intern (lname), len); \ + return fn (rest); \ + } +#define DEFUN_GSUBR_MANY(lname, fn, minargs, maxargs) \ + Lisp_Object \ + gsubr_ ## fn (Lisp_Object rest) \ + { \ + int len = scm_to_int (scm_length (rest)); \ + Lisp_Object *args; \ + SAFE_ALLOCA_LISP (args, len); \ + int i; \ + for (i = 0; \ + i < len && scm_is_pair (rest); \ + i++, rest = SCM_CDR (rest)) \ + args[i] = SCM_CAR (rest); \ + if (i < minargs) \ + xsignal2 (Qwrong_number_of_arguments, \ + intern (lname), make_number (i)); \ + return fn (i, args); \ + } /* Note that the weird token-substitution semantics of ANSI C makes this work for MANY and UNEVALLED. */ @@ -2722,7 +2412,7 @@ FUNCTIONP (Lisp_Object obj) /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ -extern void defsubr (struct Lisp_Subr *); +extern void defsubr (const char *, scm_t_subr, short, short, const char *); enum maxargs { @@ -2828,10 +2518,6 @@ typedef jmp_buf sys_jmp_buf; union specbinding. But only eval.c should access it. */ enum specbind_tag { - SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ - SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ - SPECPDL_UNWIND_INT, /* Likewise, on int. */ - SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */ @@ -2844,21 +2530,28 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + } frame; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (Lisp_Object); Lisp_Object arg; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void *); void *arg; } unwind_ptr; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (int); int arg; } unwind_int; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void); } unwind_void; struct { @@ -2910,61 +2603,18 @@ enum handlertype { CATCHER, CONDITION_CASE }; struct handler { enum handlertype type; + Lisp_Object ptag; Lisp_Object tag_or_ch; Lisp_Object val; + Lisp_Object var; + Lisp_Object body; struct handler *next; - struct handler *nextfree; - - /* The bytecode interpreter can have several handlers active at the same - time, so when we longjmp to one of them, it needs to know which handler - this was and what was the corresponding internal state. This is stored - here, and when we longjmp we make sure that handlerlist points to the - proper handler. */ - Lisp_Object *bytecode_top; - int bytecode_dest; - - /* Most global vars are reset to their value via the specpdl mechanism, - but a few others are handled by storing their value here. */ -#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */ - struct gcpro *gcpro; -#endif - sys_jmp_buf jmp; EMACS_INT lisp_eval_depth; - ptrdiff_t pdlcount; - int poll_suppress_count; int interrupt_input_blocked; - 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)->gcpro = gcprolist; \ - (c)->byte_stack = byte_stack_list; \ - handlerlist = (c); - - extern Lisp_Object memory_signal_data; -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -extern char *stack_bottom; - /* 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 do QUIT at times when it is safe to quit. @@ -3031,36 +2681,6 @@ struct gcpro #endif }; -/* Values of GC_MARK_STACK during compilation: - - 0 Use GCPRO as before - 1 Do the real thing, make GCPROs and UNGCPRO no-ops. - 2 Mark the stack, and check that everything GCPRO'd is - marked. - 3 Mark using GCPRO's, mark stack last, and count how many - dead objects are kept alive. - - Formerly, method 0 was used. Currently, method 1 is used unless - otherwise specified by hand when building, e.g., - "make CPPFLAGS='-DGC_MARK_STACK=GC_USE_GCPROS_AS_BEFORE'". - Methods 2 and 3 are present mainly to debug the transition from 0 to 1. */ - -#define GC_USE_GCPROS_AS_BEFORE 0 -#define GC_MAKE_GCPROS_NOOPS 1 -#define GC_MARK_STACK_CHECK_GCPROS 2 -#define GC_USE_GCPROS_CHECK_ZOMBIES 3 - -#ifndef GC_MARK_STACK -#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS -#endif - -/* Whether we do the stack marking manually. */ -#define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ - || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) - - -#if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS - /* Do something silly with gcproN vars just so gcc shuts up. */ /* You get warnings from MIPSPro... */ @@ -3078,136 +2698,6 @@ struct gcpro #define GCPRO7(a, b, c, d, e, f, g) (GCPRO6 (a, b, c, d, e, f), (void) gcpro7) #define UNGCPRO ((void) 0) -#else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */ - -#ifndef DEBUG_GCPRO - -#define GCPRO1(varname) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ - gcprolist = &gcpro1; } - -#define GCPRO2(varname1, varname2) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcprolist = &gcpro2; } - -#define GCPRO3(varname1, varname2, varname3) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcprolist = &gcpro3; } - -#define GCPRO4(varname1, varname2, varname3, varname4) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcprolist = &gcpro4; } - -#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ - gcprolist = &gcpro5; } - -#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ - gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \ - gcprolist = &gcpro6; } - -#define GCPRO7(a, b, c, d, e, f, g) \ - {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \ - gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \ - gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \ - gcprolist = &gcpro7; } - -#define UNGCPRO (gcprolist = gcpro1.next) - -#else - -extern int gcpro_level; - -#define GCPRO1(varname) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level++; \ - gcprolist = &gcpro1; } - -#define GCPRO2(varname1, varname2) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro2.level = gcpro_level++; \ - gcprolist = &gcpro2; } - -#define GCPRO3(varname1, varname2, varname3) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro3.level = gcpro_level++; \ - gcprolist = &gcpro3; } - -#define GCPRO4(varname1, varname2, varname3, varname4) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcpro4.level = gcpro_level++; \ - gcprolist = &gcpro4; } - -#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ - gcpro5.level = gcpro_level++; \ - gcprolist = &gcpro5; } - -#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ - gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \ - gcpro6.level = gcpro_level++; \ - gcprolist = &gcpro6; } - -#define GCPRO7(a, b, c, d, e, f, g) \ - {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \ - gcpro1.level = gcpro_level; \ - gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \ - gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \ - gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \ - gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \ - gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \ - gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \ - gcpro7.level = gcpro_level++; \ - gcprolist = &gcpro7; } - -#define UNGCPRO \ - (--gcpro_level != gcpro1.level \ - ? emacs_abort () \ - : (void) (gcprolist = gcpro1.next)) - -#endif /* DEBUG_GCPRO */ -#endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */ - - /* Evaluate expr, UNGCPRO, and then return the value of expr. */ #define RETURN_UNGCPRO(expr) \ do \ @@ -3265,19 +2755,25 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { - XSYMBOL (sym)->function = function; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + scm_variable_set_x (scm_module_lookup (function_module, sym), function); } -INLINE void -set_symbol_plist (Lisp_Object sym, Lisp_Object plist) +INLINE Lisp_Object +symbol_plist (Lisp_Object sym) { - XSYMBOL (sym)->plist = plist; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + return scm_variable_ref (scm_module_lookup (plist_module, sym)); } INLINE void -set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) +set_symbol_plist (Lisp_Object sym, Lisp_Object plist) { - XSYMBOL (sym)->next = next; + if (EQ (sym, Qnil)) sym = Qnil_; + if (EQ (sym, Qt)) sym = Qt_; + scm_variable_set_x (scm_module_lookup (plist_module, sym), plist); } /* Buffer-local (also frame-local) variable access functions. */ @@ -3350,7 +2846,8 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) } /* Defined in data.c. */ -extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; +extern Lisp_Object Qnil_, Qt_; +extern Lisp_Object Qquote, Qunbound; extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; extern Lisp_Object Qerror, Qquit, Qargs_out_of_range; extern Lisp_Object Qvoid_variable, Qvoid_function; @@ -3361,26 +2858,19 @@ extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; extern Lisp_Object Qtext_read_only; extern Lisp_Object Qinteractive_form; extern Lisp_Object Qcircular_list; -extern Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp; -extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; -extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; -extern Lisp_Object Qbuffer_or_string_p; +extern Lisp_Object Qsequencep; +extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p; extern Lisp_Object Qfboundp; -extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; +extern Lisp_Object Qspecial_operator; extern Lisp_Object Qcdr; extern Lisp_Object Qrange_error, Qoverflow_error; -extern Lisp_Object Qfloatp; -extern Lisp_Object Qnumberp, Qnumber_or_marker_p; +extern Lisp_Object Qnumber_or_marker_p; extern Lisp_Object Qbuffer, Qinteger, Qsymbol; -extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; - -EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; - /* Defined in data.c. */ extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); @@ -3423,15 +2913,14 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); -extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); +extern sym_t indirect_variable (sym_t ); extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_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, bool); extern void syms_of_data (void); -extern void swap_in_global_binding (struct Lisp_Symbol *); +extern void swap_in_global_binding (sym_t ); /* Defined in cmds.c */ extern void syms_of_cmds (void); @@ -3446,11 +2935,8 @@ extern void init_coding_once (void); extern void syms_of_coding (void); /* Defined in character.c. */ -EXFUN (Fmax_char, 0) ATTRIBUTE_CONST; extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t); extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t); -extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST; -extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST; extern void syms_of_character (void); /* Defined in charset.c. */ @@ -3460,9 +2946,6 @@ extern void syms_of_charset (void); /* Structure forward declarations. */ struct charset; -/* Defined in composite.c. */ -extern void syms_of_composite (void); - /* Defined in syntax.c. */ extern void init_syntax_once (void); extern void syms_of_syntax (void); @@ -3470,7 +2953,6 @@ extern void syms_of_syntax (void); /* Defined in fns.c. */ extern Lisp_Object QCrehash_size, QCrehash_threshold; enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; -EXFUN (Fidentity, 1) ATTRIBUTE_CONST; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); @@ -3485,7 +2967,8 @@ 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; - +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, ptrdiff_t, ptrdiff_t); extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); @@ -3500,10 +2983,10 @@ extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t); extern Lisp_Object string_to_multibyte (Lisp_Object); extern Lisp_Object string_make_unibyte (Lisp_Object); +extern void init_fns_once (void); extern void syms_of_fns (void); /* Defined in floatfns.c. */ -extern double extract_float (Lisp_Object); extern void syms_of_floatfns (void); extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y); @@ -3524,6 +3007,7 @@ extern void syms_of_image (void); /* Defined in insdel.c. */ extern Lisp_Object Qinhibit_modification_hooks; +extern Lisp_Object Qregion_extract_function; extern void move_gap_both (ptrdiff_t, ptrdiff_t); extern _Noreturn void buffer_overflow (void); extern void make_gap (ptrdiff_t); @@ -3576,18 +3060,16 @@ _Noreturn void __executable_start (void); #endif extern Lisp_Object Vwindow_system; extern Lisp_Object sit_for (Lisp_Object, bool, int); -extern void init_display (void); -extern void syms_of_display (void); /* Defined in xdisp.c. */ extern Lisp_Object Qinhibit_point_motion_hooks; -extern Lisp_Object Qinhibit_redisplay, Qdisplay; +extern Lisp_Object Qinhibit_redisplay; extern Lisp_Object Qmenu_bar_update_hook; extern Lisp_Object Qwindow_scroll_functions; extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; -extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; +extern Lisp_Object Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; extern Lisp_Object Qspace, Qcenter, QCalign_to; -extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow; +extern Lisp_Object Qbar, Qhbar, Qhollow; extern Lisp_Object Qleft_margin, Qright_margin; extern Lisp_Object QCdata, QCfile; extern Lisp_Object QCmap; @@ -3614,7 +3096,6 @@ extern void message_log_maybe_newline (void); extern void update_echo_area (void); extern void truncate_echo_area (ptrdiff_t); extern void redisplay (void); -extern void redisplay_preserve_echo_area (int); void set_frame_cursor_types (struct frame *, Lisp_Object); extern void syms_of_xdisp (void); @@ -3636,17 +3117,11 @@ extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); extern _Noreturn void buffer_memory_full (ptrdiff_t); -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); #endif extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; -extern Lisp_Object *stack_base; -extern EMACS_INT consing_since_gc; -extern EMACS_INT gc_relative_threshold; -extern EMACS_INT memory_full_cons_threshold; extern Lisp_Object list1 (Lisp_Object); extern Lisp_Object list2 (Lisp_Object, Lisp_Object); extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); @@ -3722,7 +3197,6 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern void make_byte_code (struct Lisp_Vector *); -extern Lisp_Object Qautomatic_gc; extern Lisp_Object Qchar_table_extra_slots; extern struct Lisp_Vector *allocate_vector (EMACS_INT); @@ -3756,11 +3230,8 @@ extern struct window *allocate_window (void); extern struct frame *allocate_frame (void); extern struct Lisp_Process *allocate_process (void); extern struct terminal *allocate_terminal (void); -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 make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); @@ -3772,19 +3243,12 @@ extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); -extern void free_marker (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 int valid_lisp_object_p (Lisp_Object); extern int relocatable_string_data_p (const char *); -#ifdef GC_CHECK_CONS_LIST -extern void check_cons_list (void); -#else -INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } -#endif #ifdef REL_ALLOC /* Defined in ralloc.c. */ @@ -3797,12 +3261,9 @@ extern void r_alloc_inhibit_buffer_relocation (int); /* Defined in chartab.c. */ extern Lisp_Object copy_char_table (Lisp_Object); -extern Lisp_Object char_table_ref (Lisp_Object, int); extern Lisp_Object char_table_ref_and_range (Lisp_Object, int, int *, int *); -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), Lisp_Object, Lisp_Object, Lisp_Object); @@ -3850,6 +3311,7 @@ extern Lisp_Object Qlexical_binding; extern Lisp_Object check_obarray (Lisp_Object); extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); +extern Lisp_Object obhash (Lisp_Object); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); INLINE void LOADHIST_ATTACH (Lisp_Object x) @@ -3880,7 +3342,7 @@ intern_c_string (const char *str) } /* Defined in eval.c. */ -extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro; +extern Lisp_Object Qexit, Qinteractive, Qcommandp, Qmacro; extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; @@ -3908,6 +3370,7 @@ extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); extern Lisp_Object eval_sub (Lisp_Object form); +extern Lisp_Object Ffuncall (ptrdiff_t nargs, Lisp_Object *args); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); extern Lisp_Object call0 (Lisp_Object); extern Lisp_Object call1 (Lisp_Object, Lisp_Object); @@ -3926,15 +3389,16 @@ 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_1 (void (*) (Lisp_Object), Lisp_Object, bool); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_ptr_1 (void (*) (void *), void *, bool); extern void record_unwind_protect_ptr (void (*) (void *), void *); +extern void record_unwind_protect_int_1 (void (*) (int), int, bool); extern void record_unwind_protect_int (void (*) (int), int); +extern void record_unwind_protect_void_1 (void (*) (void), bool); extern void record_unwind_protect_void (void (*) (void)); -extern void record_unwind_protect_nothing (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 dynwind_begin (void); +extern void dynwind_end (void); extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern _Noreturn void verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); @@ -3952,8 +3416,11 @@ extern void record_in_backtrace (Lisp_Object function, extern void mark_specpdl (void); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); -extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +extern bool let_shadows_buffer_binding_p (sym_t symbol); extern bool let_shadows_global_binding_p (Lisp_Object symbol); +extern _Noreturn SCM abort_to_prompt (SCM, SCM); +extern SCM call_with_prompt (SCM, SCM, SCM); +extern SCM make_prompt_tag (void); /* Defined in editfns.c. */ @@ -4015,9 +3482,10 @@ extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int); -EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */ extern void close_file_unwind (int); +extern void close_file_ptr_unwind (void *); extern void fclose_unwind (void *); +extern void fclose_ptr_unwind (void *); extern void restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); @@ -4089,8 +3557,7 @@ extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); extern Lisp_Object Qdisabled, QCfilter; -extern Lisp_Object Qup, Qdown, Qbottom; -extern Lisp_Object Qtop; +extern Lisp_Object Qup, Qdown; extern Lisp_Object last_undo_boundary; extern bool input_pending; extern Lisp_Object menu_bar_items (Lisp_Object); @@ -4122,14 +3589,11 @@ extern void syms_of_indent (void); /* Defined in frame.c. */ extern Lisp_Object Qonly, Qnone; -extern Lisp_Object Qvisible; extern void set_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); -#if HAVE_NS || HAVE_NTGUI extern Lisp_Object get_frame_param (struct frame *, Lisp_Object); -#endif extern void frames_discard_buffer (Lisp_Object); extern void syms_of_frame (void); @@ -4180,10 +3644,8 @@ extern bool running_asynch_code; /* Defined in process.c. */ extern Lisp_Object QCtype, Qlocal; extern void kill_buffer_processes (Lisp_Object); -extern bool wait_reading_process_output (intmax_t, int, int, bool, - Lisp_Object, - struct Lisp_Process *, - int); +extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object, + struct Lisp_Process *, int); /* Max value for the first argument of wait_reading_process_output. */ #if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5) /* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3. @@ -4221,11 +3683,6 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern struct byte_stack *byte_stack_list; -#if BYTE_MARK_STACK -extern void mark_byte_stack (void); -#endif -extern void unmark_byte_stack (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); @@ -4246,9 +3703,8 @@ extern void record_property_change (ptrdiff_t, ptrdiff_t, Lisp_Object); extern void syms_of_undo (void); /* Defined in textprop.c. */ -extern Lisp_Object Qfont, Qmouse_face; +extern Lisp_Object Qmouse_face; extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; -extern Lisp_Object Qfront_sticky, Qrear_nonsticky; extern Lisp_Object Qminibuffer_prompt; extern void report_interval_modification (Lisp_Object, Lisp_Object); @@ -4271,7 +3727,6 @@ extern char *get_current_dir_name (void); #endif extern void stuff_char (char c); extern void init_foreground_group (void); -extern void init_sigio (int); extern void sys_subshell (void); extern void sys_suspend (void); extern void discard_tty_input (void); @@ -4356,8 +3811,8 @@ extern void syms_of_w32notify (void); #endif /* Defined in xfaces.c. */ -extern Lisp_Object Qdefault, Qtool_bar, Qfringe; -extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor; +extern Lisp_Object Qdefault, Qfringe; +extern Lisp_Object Qscroll_bar, Qcursor; extern Lisp_Object Qmode_line_inactive; extern Lisp_Object Qface; extern Lisp_Object Qnormal; @@ -4416,10 +3871,6 @@ extern void syms_of_profiler (void); /* Defined in msdos.c, w32.c. */ extern char *emacs_root_dir (void); #endif /* DOS_NT */ - -/* True means Emacs has already been initialized. - Used during startup to detect startup of dumped Emacs. */ -extern bool initialized; /* True means ^G can quit instantly. */ extern bool immediate_quit; @@ -4428,10 +3879,16 @@ 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 xfree (void *); +extern void *xmalloc_uncollectable (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +extern void *xmalloc_unsafe (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); 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 void *xmalloc_atomic (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +extern void *xzalloc_atomic (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +extern void *xmalloc_atomic_unsafe (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +extern void *xnmalloc_atomic (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); extern char *xstrdup (const char *) ATTRIBUTE_MALLOC; extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; @@ -4466,16 +3923,13 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); - -#define USE_SAFE_ALLOCA \ - ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false +#define USE_SAFE_ALLOCA ((void) 0) /* SAFE_ALLOCA allocates a simple buffer. */ #define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \ ? alloca (size) \ - : (sa_must_free = true, record_xmalloc (size))) + : xmalloc (size)) /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER * NITEMS items, each of the same type as *BUF. MULTIPLIER must @@ -4486,23 +3940,12 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \ (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \ else \ - { \ - (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ - sa_must_free = true; \ - record_unwind_protect_ptr (xfree, buf); \ - } \ - } while (false) + (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ + } while (0) /* SAFE_FREE frees xmalloced memory and enables GC as needed. */ -#define SAFE_FREE() \ - do { \ - if (sa_must_free) { \ - sa_must_free = false; \ - unbind_to (sa_count, Qnil); \ - } \ - } while (false) - +#define SAFE_FREE() ((void) 0) /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */ @@ -4511,13 +3954,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); 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_memory (buf, nelt); \ - sa_must_free = true; \ - record_unwind_protect (free_save_value, arg_); \ - } \ + buf = xmalloc ((nelt) * word_size); \ else \ memory_full (SIZE_MAX); \ } while (false) @@ -4549,11 +3986,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); INLINE void maybe_gc (void) { - if ((consing_since_gc > gc_cons_threshold - && consing_since_gc > gc_relative_threshold) - || (!NILP (Vmemory_full) - && consing_since_gc > memory_full_cons_threshold)) - Fgarbage_collect (); + return; } INLINE bool @@ -4575,8 +4008,8 @@ functionp (Lisp_Object object) } } - if (SUBRP (object)) - return XSUBR (object)->max_args != UNEVALLED; + if (scm_is_true (scm_procedure_p (object))) + return 1; else if (COMPILEDP (object)) return true; else if (CONSP (object)) @@ -4584,10 +4017,7 @@ functionp (Lisp_Object object) Lisp_Object car = XCAR (object); return EQ (car, Qlambda) || EQ (car, Qclosure); } - else - return false; } INLINE_HEADER_END - #endif /* EMACS_LISP_H */