X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3e1fc7fbd10bdf5fc2d4e0c6fdb21c583d445602..efdd2e5c64957ecd43765763ab59edda56127b08:/src/lisp.h
diff --git a/src/lisp.h b/src/lisp.h
index 72ae5a1afd..38d5d3cdd0 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,33 @@ 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)
#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
+#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 +328,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 +341,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 +405,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 +440,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 +474,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 +500,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 +522,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 +565,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 +582,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 +605,60 @@ 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_;
-INLINE struct Lisp_Float *
-XFLOAT (Lisp_Object a)
+INLINE struct Lisp_Symbol *
+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 scm_to_pointer (tem);
}
/* Pseudovector types. */
@@ -888,83 +667,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) = (b)->self)
+#define XSETMISC(a, b) (a) = ((union Lisp_Misc *) (b))->u_any.self
/* Pseudovector types. */
@@ -980,7 +738,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 +760,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 +772,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 +782,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 +822,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 +900,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
@@ -1207,9 +926,10 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
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.
@@ -1370,7 +1090,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;
}
@@ -1511,32 +1231,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. */
@@ -1559,15 +1253,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,
@@ -1578,7 +1263,7 @@ 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.
@@ -1592,10 +1277,6 @@ struct Lisp_Symbol
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;
-
/* True means that this variable has been explicitly declared
special (with `defvar' etc), and shouldn't be lexically bound. */
bool_bf declared_special : 1;
@@ -1603,9 +1284,6 @@ struct Lisp_Symbol
/* 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;
-
/* Value of the symbol or Qunbound if unbound. Which alternative of the
union is used depends on the `redirect' field above. */
union {
@@ -1614,15 +1292,6 @@ struct Lisp_Symbol
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;
};
/* Value is name of symbol. */
@@ -1673,7 +1342,9 @@ SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
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. */
@@ -1681,15 +1352,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
@@ -1785,7 +1458,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) \
@@ -1869,23 +1542,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. */
@@ -1937,9 +1608,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;
@@ -2015,9 +1685,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
@@ -2088,22 +1758,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;
@@ -2112,7 +1772,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 *
@@ -2269,21 +1929,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
@@ -2376,7 +2022,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)
@@ -2422,12 +2068,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
@@ -2454,12 +2099,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)
{
@@ -2551,9 +2190,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)
@@ -2670,24 +2309,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. */
@@ -2716,7 +2402,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
{
@@ -2822,10 +2508,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. */
@@ -2838,21 +2520,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 {
@@ -2904,61 +2593,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.
@@ -3025,36 +2671,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... */
@@ -3072,136 +2688,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 \
@@ -3259,19 +2745,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. */
@@ -3344,7 +2836,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;
@@ -3355,26 +2848,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);
@@ -3421,7 +2907,6 @@ extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
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);
@@ -3440,11 +2925,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. */
@@ -3454,9 +2936,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);
@@ -3464,7 +2943,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);
@@ -3479,7 +2957,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);
@@ -3494,10 +2973,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);
@@ -3518,6 +2997,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);
@@ -3570,18 +3050,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;
@@ -3608,7 +3086,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);
@@ -3630,17 +3107,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);
@@ -3716,7 +3187,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);
@@ -3750,11 +3220,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);
@@ -3766,19 +3233,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. */
@@ -3791,12 +3251,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);
@@ -3844,6 +3301,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)
@@ -3874,7 +3332,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;
@@ -3902,6 +3360,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);
@@ -3920,15 +3379,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);
@@ -3948,6 +3408,9 @@ 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_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. */
@@ -4010,7 +3473,9 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, int);
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);
@@ -4082,8 +3547,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);
@@ -4115,7 +3579,6 @@ 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);
@@ -4210,11 +3673,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 *);
@@ -4235,9 +3693,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);
@@ -4260,7 +3717,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);
@@ -4345,8 +3801,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;
@@ -4405,10 +3861,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;
@@ -4417,10 +3869,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;
@@ -4455,16 +3913,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
@@ -4475,23 +3930,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. */
@@ -4500,13 +3944,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)
@@ -4538,11 +3976,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
@@ -4564,8 +3998,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))
@@ -4573,10 +4007,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 */