* bug#11935: XINT etc. should be functions
@ 2012-07-13 15:07 Paul Eggert
2012-07-14 2:20 ` bug#11935: [TRUNCATED MESSAGE 2746 87596] " Richard Stallman
` (3 more replies)
0 siblings, 4 replies; 41+ messages in thread
From: Paul Eggert @ 2012-07-13 15:07 UTC (permalink / raw)
To: 11935
Tags: patch
Here's a patch I plan to install after some more testing.
It changes lisp.h to prefer functions to function-like
macros, and constants to object-like macros, when either
will do. This makes the code easier to debug, as the
symbols are visible to GDB. It also simplifies use, as
there's no more need to worry about arguments' side effects
being evaluated multiple times.
So, for example, instead of this:
#if USE_LSB_TAG
#define XINT(a) (XLI (a) >> INTTYPEBITS)
#else
#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS)
#endif
we now have this:
static inline EMACS_INT
XINT (Lisp_Object a)
{
EMACS_INT i = XLI (a);
return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS;
}
In the old days Emacs had to use macros for this sort of
thing, because C compilers generated significantly faster
code with macros. Modern C compilers, however, don't have
this problem. On the contrary, I would guess that this
improves performance slightly, as it shrinks the size of
Emacs's text segment by 0.5% on my platform (x86-64, GCC
4.7.1).
=== modified file 'ChangeLog'
--- ChangeLog 2012-07-13 02:38:30 +0000
+++ ChangeLog 2012-07-13 03:38:40 +0000
@@ -1,3 +1,9 @@
+2012-07-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use functions, not macros, for XINT etc.
+ * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast,
+ as it generates bogus warnings about reasonable casts of calls.
+
2012-07-13 Glenn Morris <rgm@gnu.org>
* configure.ac (opsysfile): Set to empty on gnu, cygwin.
=== modified file 'configure.ac'
--- configure.ac 2012-07-13 02:38:30 +0000
+++ configure.ac 2012-07-13 03:38:40 +0000
@@ -675,6 +675,7 @@
nw="$nw -Winline" # OK to ignore 'inline'
nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
+ nw="$nw -Wbad-function-cast" # These casts are no worse than others.
# Emacs doesn't care about shadowing; see
# <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
=== modified file 'src/ChangeLog'
--- src/ChangeLog 2012-07-13 12:20:07 +0000
+++ src/ChangeLog 2012-07-13 14:46:11 +0000
@@ -1,3 +1,121 @@
+2012-07-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use functions, not macros, for XINT etc.
+ In lisp.h, prefer functions to function-like macros, and
+ constants to object-like macros, when either will do. This:
+ . makes the code easier to debug, as the symbols are visible to GDB.
+ . simplifies use, as there's no more need to worry about
+ arguments' side effects being evaluated multiple times.
+ . shrinks the size of Emacs's text segment by 0.5%
+ on my platform (x86-64, GCC 4.7.1).
+ * buffer.c (Qoverlap):
+ * data.c (Qsubrp):
+ * fns.c (Qhash_table_p):
+ Now extern, so lisp.h can use these symbols.
+ * dispextern.h: Include character.h, for MAX_CHAR etc.
+ (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE)
+ (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
+ (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P)
+ (GLYPH_CODE_P): Move here from lisp.h.
+ (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
+ (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros.
+ (GLYPH_MODE_LINE_FACE): Now enums, not macros.
+ * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since
+ XUNTAG now returns void *.
+ * lisp.h (CHECK_CONS_LIST, LISP_INT_TAG_P, XLI, XIL, XHASH, XTYPE)
+ (XINT, XFASTINT, XUINT, make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR)
+ (XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR)
+ (XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR, CHECK_TYPE)
+ (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR)
+ (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, STRING_INTERVALS)
+ (STRING_SET_INTERVALS, SDATA, SSDATA, SREF, SSET, SCHARS)
+ (STRING_BYTES, SBYTES, STRING_SET_CHARS, ASIZE, ASET)
+ (CHAR_TABLE_EXTRA_SLOTS, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF)
+ (CHAR_TABLE_TRANSLATE, CHAR_TABLE_SET, SYMBOL_VAL, SYMBOL_ALIAS)
+ (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS)
+ (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P)
+ (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P)
+ (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_TABLE_SIZE)
+ (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XSETMISCTYPE)
+ (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE, XFWDTYPE)
+ (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD)
+ (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP)
+ (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP)
+ (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP)
+ (MARKERP, SAVE_VALUEP, INTFWDP, BOOLFWDP, OBJFWDP)
+ (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_SIZE_TYPEP)
+ (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP)
+ (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P)
+ (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP)
+ (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING)
+ (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE)
+ (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY)
+ (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW)
+ (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR)
+ (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT)
+ (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY)
+ (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR)
+ (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH)
+ (IS_DIRECTORY_SEP, IS_DEVICE_SEP, IS_ANY_SEP):
+ Now static inline functions, not macros.
+ (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function.
+ (EMACS_INT, EMACS_UINT): Now typedefs, not macros.
+ (VALBITS, INTTYPEBITS, FIXNUM_BITS, LISP_INT_TAG)
+ (PSEUDOVECTOR_SIZE_BITS, PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK)
+ (BOOL_VECTOR_BITS_PER_CHAR, CHAR_TABLE_STANDARD_SLOTS)
+ (CHARTAB_SIZE_BITS_0, CHARTAB_SIZE_BITS_1)
+ (CHARTAB_SIZE_BITS_2, CHARTAB_SIZE_BITS_3, DEFAULT_HASH_SIZE)
+ (COMPILED_ARGLIST, COMPILED_BYTECODE, COMPILED_CONSTANTS)
+ (COMPILED_STACK_DEPTH, COMPILED_DOC_STRING, COMPILED_INTERACTIVE)
+ (CHAR_ALT, CHAR_SUPER, CHAR_HYPER, CHAR_SHIFT, CHAR_CTL, CHAR_META)
+ (CHAR_MODIFIER_MASK, MANY, UNEVALLED, FLOAT_TO_STRING_BUFSIZE):
+ (DIRECTORY_SEP, MAX_ALLOCA):
+ Now constants, not macros.
+ (LISP_INT1_TAG, LISP_STRING_TAG, LISP_MAKE_RVALUE, TYPEMASK):
+ Remove; no longer needed.
+ (DATA_SEG_BITS): Default to 0, as this simplifies the rest of the code.
+ (VALMASK): Define in one place rather than in two, merging the
+ USE_LSB_TAG parts; this is simpler.
+ (MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM, max, min)
+ (struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P):
+ Move up, to avoid use before definition.
+ Also include "globals.h" earlier, for the same reason.
+ (make_natnum, xtag): New functions.
+ (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts.
+ (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP)
+ (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP)
+ (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP)
+ (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP)
+ (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set)
+ (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p)
+ (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp)
+ (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp)
+ (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument)
+ (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp)
+ (Qwindow_configuration_p, Qimage): New forward declarations.
+ (XSET): Simplify by rewriting in terms of xtag.
+ (XSETFASTINT): Simplify by rewriting in terms of make_natnum.
+ (STRING_COPYIN): Remove; unused.
+ (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE)
+ (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE)
+ (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P)
+ (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use.
+ (TYPE_RANGED_INTEGERP): Simplify.
+ (PSEUDOVECTOR_SIZE_TYPEP): Rename from PSEUDOVECTORP_TYPEP and
+ change the first arg to be a size rather than a pointer,
+ to make it usable as a function. All uses changed.
+ (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls.
+ (setlocale, fixup_locale, synchronize_system_messages_locale)
+ (synchronize_system_time_locale) [!HAVE_SETLOCALE]:
+ Now empty functions, not macros.
+ * mem-limits.h (EXCEEDS_LISP_PTR) [!defined DATA_SEG_BITS]:
+ Remove, as DATA_SEG_BITS is always defined now, if only to zero.
+ * window.c (Qwindow_configuration_p):
+ Now extern, so window.h can use it.
+ * window.h (Qwindowp): Move decl back to lisp.h.
+ (CHECK_LIVE_WINDOW): Move here from lisp.h, so window.h internals
+ need not be moved to lisp.h. Now a function, not a macro.
+
2012-07-13 Kalle Kankare <kalle.kankare@iki.fi> (tiny change)
* image.c (Fimagemagick_types): Initialize ex with GetExceptionInfo
=== modified file 'src/alloc.c'
--- src/alloc.c 2012-07-11 06:14:27 +0000
+++ src/alloc.c 2012-07-13 03:37:42 +0000
@@ -3077,12 +3077,12 @@
+ VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
/* Number of bytes used by vector-block-allocated object. This is the only
- place where we actually use the `nbytes' field of the vector-header.
- I.e. we could get rid of the `nbytes' field by computing it based on the
+ place where we actually use the 'size' field of the vector-header.
+ I.e. we could get rid of the 'size' field by computing it based on the
vector-type. */
#define PSEUDOVECTOR_NBYTES(vector) \
- (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
+ (PSEUDOVECTOR_SIZE_TYPEP (vector->header.size, PVEC_FREE) \
? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
: vector->header.next.nbytes)
@@ -4382,7 +4382,7 @@
while (VECTOR_IN_BLOCK (vector, block)
&& vector <= (struct Lisp_Vector *) p)
{
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ if (PSEUDOVECTOR_SIZE_TYPEP (vector->header.size, PVEC_FREE))
vector = ADVANCE (vector, (vector->header.size
& PSEUDOVECTOR_SIZE_MASK));
else if (vector == p)
=== modified file 'src/buffer.c'
--- src/buffer.c 2012-07-10 23:24:36 +0000
+++ src/buffer.c 2012-07-13 03:37:42 +0000
@@ -139,7 +139,7 @@
static Lisp_Object Qget_file_buffer;
-static Lisp_Object Qoverlayp;
+Lisp_Object Qoverlayp;
Lisp_Object Qpriority, Qbefore_string, Qafter_string;
@@ -612,7 +612,7 @@
eassert (NILP (BVAR (b->base_buffer, begv_marker)));
eassert (NILP (BVAR (b->base_buffer, zv_marker)));
- BVAR (b->base_buffer, pt_marker)
+ BVAR (b->base_buffer, pt_marker)
= build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte);
BVAR (b->base_buffer, begv_marker)
@@ -862,7 +862,7 @@
{
/* Note fileio.c:make_temp_name does random differently. */
tem2 = concat2 (name, make_formatted_string
- (number, "-%"pI"d",
+ (number, "-%"pI"d",
XFASTINT (Frandom (make_number (999999)))));
tem = Fget_buffer (tem2);
if (NILP (tem))
=== modified file 'src/data.c'
--- src/data.c 2012-07-10 08:43:46 +0000
+++ src/data.c 2012-07-13 14:51:32 +0000
@@ -91,7 +91,8 @@
static Lisp_Object Qcompiled_function, Qframe, Qvector;
Lisp_Object Qbuffer;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
-static Lisp_Object Qsubrp, Qmany, Qunevalled;
+Lisp_Object Qsubrp;
+static Lisp_Object Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
static Lisp_Object Qdefun;
=== modified file 'src/dispextern.h'
--- src/dispextern.h 2012-07-13 03:50:58 +0000
+++ src/dispextern.h 2012-07-13 03:52:53 +0000
@@ -22,6 +22,8 @@
#ifndef DISPEXTERN_H_INCLUDED
#define DISPEXTERN_H_INCLUDED
+#include "character.h"
+
#ifdef HAVE_X_WINDOWS
#include <X11/Xlib.h>
@@ -265,6 +267,55 @@
Glyphs
***********************************************************************/
+/* The glyph datatype, used to represent characters on the display.
+ It consists of a char code and a face id. */
+
+typedef struct {
+ int ch;
+ int face_id;
+} GLYPH;
+
+/* Return a glyph's character code. */
+static inline int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; }
+
+/* Return a glyph's face ID. */
+static inline int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; }
+
+#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
+#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
+#define SET_GLYPH(glyph, char, face) \
+ ((glyph).ch = (char), (glyph).face_id = (face))
+
+/* The following are valid only if GLYPH_CODE_P (gc). */
+
+static inline int
+GLYPH_CODE_CHAR (Lisp_Object gc)
+{
+ return (CONSP (gc)
+ ? XINT (XCAR (gc))
+ : XINT (gc) & MAX_CHAR);
+}
+
+static inline int
+GLYPH_CODE_FACE (Lisp_Object gc)
+{
+ return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS;
+}
+
+#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
+ do \
+ { \
+ if (CONSP (gc)) \
+ SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
+ else \
+ SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
+ (XINT (gc) >> CHARACTERBITS)); \
+ } \
+ while (0)
+
+/* The ID of the mode line highlighting face. */
+enum { GLYPH_MODE_LINE_FACE = 1 };
+
/* Enumeration of glyph types. Glyph structures contain a type field
containing one of the enumerators defined here. */
@@ -1763,6 +1814,30 @@
#endif /* not HAVE_WINDOW_SYSTEM */
+/* Return 1 if G contains a valid character code. */
+static inline int
+GLYPH_CHAR_VALID_P (GLYPH g)
+{
+ return CHAR_VALID_P (GLYPH_CHAR (g));
+}
+
+/* The glyph code from a display vector may either be an integer which
+ encodes a char code in the lower CHARACTERBITS bits and a (very small)
+ face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
+
+static inline int
+GLYPH_CODE_P (Lisp_Object gc)
+{
+ return (CONSP (gc)
+ ? (CHARACTERP (XCAR (gc))
+ && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID))
+ : (RANGED_INTEGERP
+ (0, gc,
+ (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS
+ ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR
+ : TYPE_MAXIMUM (EMACS_INT)))));
+}
+
/* Non-zero means face attributes have been changed since the last
redisplay. Used in redisplay_internal. */
=== modified file 'src/eval.c'
--- src/eval.c 2012-07-10 16:53:26 +0000
+++ src/eval.c 2012-07-13 03:37:42 +0000
@@ -1931,7 +1931,7 @@
and assumed the docstring will be provided by Snarf-documentation, so it
passed us 0 instead. But that leads to accidental sharing in purecopy's
hash-consing, so we use a (hopefully) unique integer instead. */
- docstring = make_number (XUNTAG (function, Lisp_Symbol));
+ docstring = make_number ((intptr_t) XUNTAG (function, Lisp_Symbol));
return Ffset (function,
Fpurecopy (list5 (Qautoload, file, docstring,
interactive, type)));
=== modified file 'src/fns.c'
--- src/fns.c 2012-07-10 23:24:36 +0000
+++ src/fns.c 2012-07-13 03:37:42 +0000
@@ -3354,7 +3354,8 @@
/* Various symbols. */
-static Lisp_Object Qhash_table_p, Qkey, Qvalue;
+Lisp_Object Qhash_table_p;
+static Lisp_Object Qkey, Qvalue;
Lisp_Object Qeq, Qeql, Qequal;
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
=== modified file 'src/lisp.h'
--- src/lisp.h 2012-07-12 23:56:39 +0000
+++ src/lisp.h 2012-07-13 03:38:40 +0000
@@ -32,10 +32,10 @@
#ifdef GC_CHECK_CONS_LIST
extern void check_cons_list (void);
-#define CHECK_CONS_LIST() check_cons_list ()
#else
-#define CHECK_CONS_LIST() ((void) 0)
+static inline void check_cons_list (void) { }
#endif
+static inline void CHECK_CONS_LIST (void) { check_cons_list (); }
/* Temporarily disable wider-than-pointer integers until they're tested more.
Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
@@ -45,22 +45,24 @@
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
+#ifndef EMACS_INT_MAX
# if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT
-# define EMACS_INT long long
+typedef long long int EMACS_INT;
+typedef unsigned long long int EMACS_UINT;
# define EMACS_INT_MAX LLONG_MAX
# define pI "ll"
# elif INT_MAX < LONG_MAX
-# define EMACS_INT long
+typedef long int EMACS_INT;
+typedef unsigned long int EMACS_UINT;
# define EMACS_INT_MAX LONG_MAX
# define pI "l"
# else
-# define EMACS_INT int
+typedef int EMACS_INT;
+typedef unsigned int EMACS_UINT;
# define EMACS_INT_MAX INT_MAX
# define pI ""
# endif
#endif
-#define EMACS_UINT unsigned EMACS_INT
/* Number of bits in some machine integer types. */
enum
@@ -153,8 +155,10 @@
variable VAR of type TYPE with the added requirement that it be
TYPEBITS-aligned. */
+/* Number of bits in a Lisp_Obect tag. This can be used in #if. */
#define GCTYPEBITS 3
-#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS)
+
+enum { VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS };
/* 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.
@@ -216,14 +220,10 @@
/* 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 INTTYPEBITS (GCTYPEBITS - 1)
-#define FIXNUM_BITS (VALBITS + 1)
+enum { INTTYPEBITS = GCTYPEBITS - 1 };
+enum { FIXNUM_BITS = VALBITS + 1 };
#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
-#define LISP_INT_TAG Lisp_Int0
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
-#define LISP_INT1_TAG (USE_LSB_TAG ? 1 << INTTYPEBITS : 1)
-#define LISP_STRING_TAG (5 - LISP_INT1_TAG)
-#define LISP_INT_TAG_P(x) (((x) & ~LISP_INT1_TAG) == 0)
/* Stolen from GDB. The only known compiler that doesn't support
enums in bitfields is MSVC. */
@@ -238,7 +238,7 @@
{
/* Integer. XINT (obj) is the integer value. */
Lisp_Int0 = 0,
- Lisp_Int1 = LISP_INT1_TAG,
+ Lisp_Int1 = USE_LSB_TAG ? 4 : 1,
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
Lisp_Symbol = 2,
@@ -249,7 +249,7 @@
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
- Lisp_String = LISP_STRING_TAG,
+ Lisp_String = USE_LSB_TAG ? 1 : 4,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
@@ -263,6 +263,11 @@
Lisp_Float = 7,
};
+/* An older name for Lisp_Int0. */
+enum { LISP_INT_TAG = Lisp_Int0 };
+
+static inline int LISP_INT_TAG_P (int x) { return (x & ~Lisp_Int1) == 0; }
+
/* This is the set of data types that share a common structure.
The first member of the structure is a type code from this set.
The enum values are arbitrary, but we'll use large numbers to make it
@@ -297,7 +302,8 @@
typedef struct { EMACS_INT i; } Lisp_Object;
-#define XLI(o) (o).i
+static inline EMACS_INT XLI (Lisp_Object o) { return o.i; }
+
static inline Lisp_Object
XIL (EMACS_INT i)
{
@@ -305,12 +311,6 @@
return o;
}
-static inline Lisp_Object
-LISP_MAKE_RVALUE (Lisp_Object o)
-{
- return o;
-}
-
#define LISP_INITIALLY_ZERO {0}
#else /* CHECK_LISP_OBJECT_TYPE */
@@ -318,9 +318,8 @@
/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
-#define XLI(o) (o)
-#define XIL(i) (i)
-#define LISP_MAKE_RVALUE(o) (0+(o))
+static inline EMACS_INT XLI (Lisp_Object o) { return o; }
+static inline Lisp_Object XIL (EMACS_INT i) { return i; }
#define LISP_INITIALLY_ZERO 0
#endif /* CHECK_LISP_OBJECT_TYPE */
@@ -368,89 +367,119 @@
only the number of Lisp_Object fields (that need to be traced by the GC).
The distinction is used e.g. by Lisp_Process which places extra
non-Lisp_Object fields at the end of the structure. */
-#define PSEUDOVECTOR_SIZE_BITS 16
-#define PSEUDOVECTOR_SIZE_MASK ((1 << PSEUDOVECTOR_SIZE_BITS) - 1)
-#define PVEC_TYPE_MASK (0x0fff << PSEUDOVECTOR_SIZE_BITS)
+enum
+ {
+ PSEUDOVECTOR_SIZE_BITS = 16,
+ PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
+ PVEC_TYPE_MASK = 0xfff << PSEUDOVECTOR_SIZE_BITS
+ };
/* Number of bits to put in each character in the internal representation
of bool vectors. This should not vary across implementations. */
-#define BOOL_VECTOR_BITS_PER_CHAR 8
-\f
-/* These macros extract various sorts of values from a Lisp_Object.
+enum { BOOL_VECTOR_BITS_PER_CHAR = 8 };
+\f
+/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
+ which were stored in a Lisp_Object */
+#ifndef DATA_SEG_BITS
+# define DATA_SEG_BITS 0
+#endif
+\f
+/* These functions extract various sorts of values from a Lisp_Object.
For example, if tem is a Lisp_Object whose type is Lisp_Cons,
XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
/* Return a perfect hash of the Lisp_Object representation. */
-#define XHASH(a) XLI (a)
-
-#if USE_LSB_TAG
-
-#define TYPEMASK ((1 << GCTYPEBITS) - 1)
-#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK))
-#define XINT(a) (XLI (a) >> INTTYPEBITS)
-#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS)
-#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS)
-#define XSET(var, type, ptr) \
- (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \
- (var) = XIL ((type) | (intptr_t) (ptr)))
-
-#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK))
-#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type)))
-
-#else /* not USE_LSB_TAG */
-
-#define VALMASK VAL_MAX
-
-#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS))
-
-/* For integers known to be positive, XFASTINT provides fast retrieval
- and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp integers have zero-bits in their tags. */
-#define XFASTINT(a) (XLI (a) + 0)
-#define XSETFASTINT(a, b) ((a) = XIL (b))
-
-/* Extract the value of a Lisp_Object as a (un)signed integer. */
-
-#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS)
-#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK))
-#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK)
-
-#define XSET(var, type, ptr) \
- ((var) = XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((intptr_t) (ptr) & VALMASK)))
-
-#ifdef DATA_SEG_BITS
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object */
-#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS))
-#else
-#define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK))
-#endif
-
-#endif /* not USE_LSB_TAG */
-
-/* For integers known to be positive, XFASTINT sometimes provides
- faster retrieval and XSETFASTINT provides faster storage.
- If not, fallback on the non-accelerated path. */
-#ifndef XFASTINT
-# define XFASTINT(a) (XINT (a))
-# define XSETFASTINT(a, b) (XSETINT (a, b))
-#endif
-
-/* Extract the pointer value of the Lisp object A, under the
- assumption that A's type is TYPE. This is a fallback
- implementation if nothing faster is available. */
-#ifndef XUNTAG
-# define XUNTAG(a, type) XPNTR (a)
-#endif
-
-#define EQ(x, y) (XHASH (x) == XHASH (y))
+static inline EMACS_INT XHASH (Lisp_Object o) { return XLI (o); }
+
+#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
/* Largest and smallest representable fixnum values. These are the C
values. */
#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
+static inline enum Lisp_Type
+XTYPE (Lisp_Object a)
+{
+ EMACS_UINT i = XLI (a);
+ return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
+}
+
+/* Extract the value of a Lisp_Object as a signed integer. */
+static inline EMACS_INT
+XINT (Lisp_Object a)
+{
+ EMACS_INT i = XLI (a);
+ return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS;
+}
+
+/* Like XINT (A), but may be faster. A must be nonnegative. This takes
+ advantage of the fact that Lisp integers have zero-bits in their tags. */
+static inline EMACS_INT
+XFASTINT (Lisp_Object a)
+{
+ EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) >> INTTYPEBITS;
+ eassert (0 <= n);
+ return n;
+}
+
+/* Extract the value of a Lisp_Object as an unsigned integer. */
+static inline EMACS_UINT
+XUINT (Lisp_Object a)
+{
+ EMACS_UINT i = XLI (a);
+ return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
+}
+
+static inline Lisp_Object
+make_number (EMACS_INT n)
+{
+ return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK);
+}
+
+/* Like make_number (N), but may be faster. N must be in nonnegative range. */
+static inline Lisp_Object
+make_natnum (EMACS_INT n)
+{
+ eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
+ return USE_LSB_TAG ? make_number (n) : XIL (n);
+}
+
+static inline void *
+XPNTR (Lisp_Object a)
+{
+ intptr_t i = (XLI (a) & VALMASK) | DATA_SEG_BITS;
+ return (void *) i;
+}
+
+/* Extract the pointer value of the Lisp object A, under the
+ assumption that A's type is TYPE. */
+static inline void *
+XUNTAG (Lisp_Object a, int type)
+{
+ if (USE_LSB_TAG)
+ {
+ intptr_t i = XLI (a) - type;
+ return (void *) i;
+ }
+ return XPNTR (a);
+}
+
+static inline int
+EQ (Lisp_Object a, Lisp_Object b)
+{
+ return XHASH (a) == XHASH (b);
+}
+
+/* The ubiquitous min and max macros. */
+
+#ifdef max
+#undef max
+#undef min
+#endif
+#define min(a, b) ((a) < (b) ? (a) : (b))
+#define max(a, b) ((a) > (b) ? (a) : (b))
+
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
type or if I is a NaN. */
@@ -463,64 +492,181 @@
{
return num < lower ? lower : num <= upper ? num : upper;
}
+\f
+/* Forward declarations. */
+
+/* Defined in this file. */
+union Lisp_Fwd;
+static int BOOLFWDP (union Lisp_Fwd *);
+static int BOOL_VECTOR_P (Lisp_Object);
+static int BUFFER_OBJFWDP (union Lisp_Fwd *);
+static int BUFFERP (Lisp_Object);
+static int CHAR_TABLE_P (Lisp_Object);
+static Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
+static int CONSP (Lisp_Object);
+static int FLOATP (Lisp_Object);
+static int INTEGERP (Lisp_Object);
+static int INTFWDP (union Lisp_Fwd *);
+static int KBOARD_OBJFWDP (union Lisp_Fwd *);
+static int MARKERP (Lisp_Object);
+static int MISCP (Lisp_Object);
+static int NILP (Lisp_Object);
+static int OBJFWDP (union Lisp_Fwd *);
+static int OVERLAYP (Lisp_Object);
+static int PROCESSP (Lisp_Object);
+static int PSEUDOVECTORP (Lisp_Object, int);
+static int SAVE_VALUEP (Lisp_Object);
+static int STRINGP (Lisp_Object);
+static int SUB_CHAR_TABLE_P (Lisp_Object);
+static int SUBRP (Lisp_Object);
+static int SYMBOLP (Lisp_Object);
+static int VECTORLIKEP (Lisp_Object);
+static int WINDOWP (Lisp_Object);
+
+/* Defined in buffer.c. */
+extern Lisp_Object Qoverlayp;
+
+/* Defined in chartab.c. */
+extern Lisp_Object char_table_ref (Lisp_Object, int);
+extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
+extern int char_table_translate (Lisp_Object, int);
+
+/* Defined in data.c. */
+extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
+extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
+extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp;
+extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
+extern Lisp_Object Ffboundp (Lisp_Object);
+extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
+
+/* Defined in emacs.c. */
+extern int initialized;
+
+/* Defined in fns.c */
+extern Lisp_Object Qhash_table_p;
+
+/* Defined in floatfns.c. */
+extern double extract_float (Lisp_Object);
+
+/* Defined in process.c. */
+extern Lisp_Object Qprocessp;
+
+/* Defined in window.c. */
+extern Lisp_Object Qwindowp, Qwindow_configuration_p;
+
+/* Defined in xdisp.c. */
+extern Lisp_Object Qimage;
+\f
/* Extract a value or address from a Lisp_Object. */
-#define XCONS(a) (eassert (CONSP (a)), \
- (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
-#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
- (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
-#define XSTRING(a) (eassert (STRINGP (a)), \
- (struct Lisp_String *) XUNTAG (a, Lisp_String))
-#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
- (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
-#define XFLOAT(a) (eassert (FLOATP (a)), \
- (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
-
-/* Misc types. */
-
-#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
-#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any))
-#define XMISCTYPE(a) (XMISCANY (a)->type)
-#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
-#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay))
-#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC (a)->u_save_value))
-
-/* Forwarding object types. */
-
-#define XFWDTYPE(a) (a->u_intfwd.type)
-#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd))
-#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd))
-#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd))
-#define XBUFFER_OBJFWD(a) \
- (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
-#define XKBOARD_OBJFWD(a) \
- (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
+static inline struct Lisp_Cons *
+XCONS (Lisp_Object a)
+{
+ eassert (CONSP (a));
+ return XUNTAG (a, Lisp_Cons);
+}
+
+static inline struct Lisp_Vector *
+XVECTOR (Lisp_Object a)
+{
+ eassert (VECTORLIKEP (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct Lisp_String *
+XSTRING (Lisp_Object a)
+{
+ eassert (STRINGP (a));
+ return XUNTAG (a, Lisp_String);
+}
+
+static inline struct Lisp_Symbol *
+XSYMBOL (Lisp_Object a)
+{
+ eassert (SYMBOLP (a));
+ return XUNTAG (a, Lisp_Symbol);
+}
+
+static inline struct Lisp_Float *
+XFLOAT (Lisp_Object a)
+{
+ eassert (FLOATP (a));
+ return XUNTAG (a, Lisp_Float);
+}
/* Pseudovector types. */
-#define XPROCESS(a) (eassert (PROCESSP (a)), \
- (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
-#define XWINDOW(a) (eassert (WINDOWP (a)), \
- (struct window *) XUNTAG (a, Lisp_Vectorlike))
-#define XTERMINAL(a) (eassert (TERMINALP (a)), \
- (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
-#define XSUBR(a) (eassert (SUBRP (a)), \
- (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
-#define XBUFFER(a) (eassert (BUFFERP (a)), \
- (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
-#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
- (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
-#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
- ((struct Lisp_Sub_Char_Table *) \
- XUNTAG (a, Lisp_Vectorlike)))
-#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
- ((struct Lisp_Bool_Vector *) \
- XUNTAG (a, Lisp_Vectorlike)))
+static inline struct Lisp_Process *
+XPROCESS (Lisp_Object a)
+{
+ eassert (PROCESSP (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct window *
+XWINDOW (Lisp_Object a)
+{
+ eassert (WINDOWP (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct terminal *
+XTERMINAL (Lisp_Object a)
+{
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct Lisp_Subr *
+XSUBR (Lisp_Object a)
+{
+ eassert (SUBRP (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct buffer *
+XBUFFER (Lisp_Object a)
+{
+ eassert (BUFFERP (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct Lisp_Char_Table *
+XCHAR_TABLE (Lisp_Object a)
+{
+ eassert (CHAR_TABLE_P (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static inline struct Lisp_Sub_Char_Table *
+XSUB_CHAR_TABLE (Lisp_Object a)
+{
+ eassert (SUB_CHAR_TABLE_P (a));
+ return XUNTAG (a, Lisp_Vectorlike);
+}
+
+static 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. */
+static inline Lisp_Object
+xtag (enum Lisp_Type type, void *ptr)
+{
+ EMACS_UINT utype = type;
+ EMACS_INT typebits = USE_LSB_TAG ? type : utype << VALBITS;
+ Lisp_Object a = XIL (typebits | (intptr_t) ptr);
+ eassert (XUNTAG (a, type) == ptr); /* Check alignment. */
+ return a;
+}
+
+#define XSET(var, type, ptr) ((var) = xtag (type, ptr))
#define XSETINT(a, b) (a) = make_number (b)
+#define XSETFASTINT(a, b) ((a) = make_natnum (b))
#define XSETCONS(a, b) XSET (a, Lisp_Cons, b)
#define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b)
#define XSETSTRING(a, b) XSET (a, Lisp_String, b)
@@ -568,48 +714,25 @@
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
-/* Convenience macros for dealing with Lisp arrays. */
-
-#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
-#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
-/* The IDX==IDX tries to detect when the macro argument is side-effecting. */
-#define ASET(ARRAY, IDX, VAL) \
- (eassert ((IDX) == (IDX)), \
- eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
- AREF ((ARRAY), (IDX)) = (VAL))
-
-/* Convenience macros for dealing with Lisp strings. */
-
-#define SDATA(string) (XSTRING (string)->data + 0)
-#define SREF(string, index) (SDATA (string)[index] + 0)
-#define SSET(string, index, new) (SDATA (string)[index] = (new))
-#define SCHARS(string) (XSTRING (string)->size + 0)
-#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0)
-
-/* Avoid "differ in sign" warnings. */
-#define SSDATA(x) ((char *) SDATA (x))
-
-#define STRING_SET_CHARS(string, newsize) \
- (XSTRING (string)->size = (newsize))
-
-#define STRING_COPYIN(string, index, new, count) \
- memcpy (SDATA (string) + index, new, count)
-
/* Type checking. */
-#define CHECK_TYPE(ok, Qxxxp, x) \
- do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
-
-
+static inline void
+CHECK_TYPE (int ok, Lisp_Object Qxxxp, Lisp_Object x)
+{
+ if (!ok)
+ wrong_type_argument (Qxxxp, x);
+}
\f
/* See the macros in intervals.h. */
typedef struct interval *INTERVAL;
/* Complain if object is not string or buffer type */
-#define CHECK_STRING_OR_BUFFER(x) \
- CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
-
+static inline void
+CHECK_STRING_OR_BUFFER (Lisp_Object x)
+{
+ CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
+}
\f
/* In a cons, the markbit of the car is the gc mark bit */
@@ -650,54 +773,68 @@
#endif
/* Use these from normal code. */
-#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c))
-#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c))
+static inline Lisp_Object XCAR (Lisp_Object c) { return XCAR_AS_LVALUE (c); }
+static inline Lisp_Object XCDR (Lisp_Object c) { return XCDR_AS_LVALUE (c); }
/* Use these to set the fields of a cons cell.
Note that both arguments may refer to the same object, so 'n'
- should not be read after 'c' is first modified. Also, neither
- argument should be evaluated more than once; side effects are
- especially common in the second argument. */
-#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n))
-#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n))
-
-/* Take the car or cdr of something whose type is not known. */
-#define CAR(c) \
- (CONSP ((c)) ? XCAR ((c)) \
- : NILP ((c)) ? Qnil \
- : wrong_type_argument (Qlistp, (c)))
-
-#define CDR(c) \
- (CONSP ((c)) ? XCDR ((c)) \
- : NILP ((c)) ? Qnil \
- : wrong_type_argument (Qlistp, (c)))
-
-/* Take the car or cdr of something whose type is not known. */
-#define CAR_SAFE(c) \
- (CONSP ((c)) ? XCAR ((c)) : Qnil)
-
-#define CDR_SAFE(c) \
- (CONSP ((c)) ? XCDR ((c)) : Qnil)
+ should not be read after 'c' is first modified. */
+static inline void
+XSETCAR (Lisp_Object c, Lisp_Object n)
+{
+ XCAR_AS_LVALUE (c) = n;
+}
+static inline void
+XSETCDR (Lisp_Object c, Lisp_Object n)
+{
+ XCDR_AS_LVALUE (c) = n;
+}
+
+/* Take the car or cdr of something whose type is not known. */
+static inline Lisp_Object
+CAR (Lisp_Object c)
+{
+ return (CONSP (c) ? XCAR (c)
+ : NILP (c) ? Qnil
+ : wrong_type_argument (Qlistp, c));
+}
+static inline Lisp_Object
+CDR (Lisp_Object c)
+{
+ return (CONSP (c) ? XCDR (c)
+ : NILP (c) ? Qnil
+ : wrong_type_argument (Qlistp, c));
+}
+
+/* Take the car or cdr of something whose type is not known. */
+static inline Lisp_Object
+CAR_SAFE (Lisp_Object c)
+{
+ return CONSP (c) ? XCAR (c) : Qnil;
+}
+static inline Lisp_Object
+CDR_SAFE (Lisp_Object c)
+{
+ return CONSP (c) ? XCDR (c) : Qnil;
+}
+
+/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
+
+struct Lisp_String
+ {
+ ptrdiff_t size;
+ ptrdiff_t size_byte;
+ INTERVAL intervals; /* Text properties in this string. */
+ unsigned char *data;
+ };
/* Nonzero if STR is a multibyte string. */
-#define STRING_MULTIBYTE(STR) \
- (XSTRING (STR)->size_byte >= 0)
-
-/* Return the length in bytes of STR. */
-
-#ifdef GC_CHECK_STRING_BYTES
-
-struct Lisp_String;
-extern ptrdiff_t string_bytes (struct Lisp_String *);
-#define STRING_BYTES(S) string_bytes ((S))
-
-#else /* not GC_CHECK_STRING_BYTES */
-
-#define STRING_BYTES(STR) \
- ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte)
-
-#endif /* not GC_CHECK_STRING_BYTES */
+static inline int
+STRING_MULTIBYTE (Lisp_Object str)
+{
+ return 0 <= XSTRING (str)->size_byte;
+}
/* An upper bound on the number of bytes in a Lisp string, not
counting the terminating null. This a tight enough bound to
@@ -727,25 +864,72 @@
else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
/* Get text properties. */
-#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0)
+static inline INTERVAL
+STRING_INTERVALS (Lisp_Object str)
+{
+ return XSTRING (str)->intervals;
+}
/* Set text properties. */
-#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
-
-/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
-
-struct Lisp_String
- {
- ptrdiff_t size;
- ptrdiff_t size_byte;
- INTERVAL intervals; /* Text properties in this string. */
- unsigned char *data;
- };
+static inline void
+STRING_SET_INTERVALS (Lisp_Object str, INTERVAL intervals)
+{
+ XSTRING (str)->intervals = intervals;
+}
+
+/* Convenience functions for dealing with Lisp strings. */
+
+static inline unsigned char *
+SDATA (Lisp_Object string)
+{
+ return XSTRING (string)->data;
+}
+static inline char *
+SSDATA (Lisp_Object string)
+{
+ /* Avoid "differ in sign" warnings. */
+ return (char *) SDATA (string);
+}
+static inline unsigned char
+SREF (Lisp_Object string, ptrdiff_t index)
+{
+ return SDATA (string)[index];
+}
+static inline void
+SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
+{
+ SDATA (string)[index] = new;
+}
+static inline ptrdiff_t
+SCHARS (Lisp_Object string)
+{
+ return XSTRING (string)->size;
+}
+static inline ptrdiff_t
+STRING_BYTES (struct Lisp_String *s)
+{
+#ifdef GC_CHECK_STRING_BYTES
+ extern ptrdiff_t string_bytes (struct Lisp_String *);
+ return string_bytes (s);
+#else
+ return s->size_byte < 0 ? s->size : s->size_byte;
+#endif
+}
+static inline ptrdiff_t
+SBYTES (Lisp_Object string)
+{
+ return STRING_BYTES (XSTRING (string));
+}
+static inline void
+STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
+{
+ XSTRING (string)->size = newsize;
+}
/* Header of vector-like objects. This documents the layout constraints on
vectors and pseudovectors other than struct Lisp_Subr. It also prevents
- compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR
- and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *,
+ compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
+ and PSEUDOVECTORP cast their pointers to struct vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
incorrectly reorder loads and stores to their size fields. See
<http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
@@ -796,6 +980,23 @@
Lisp_Object contents[1];
};
+/* Conveniences for dealing with Lisp arrays. */
+
+/* A macro because it is also used as an lvalue. FIXME: Use ASET instead. */
+#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
+
+static inline ptrdiff_t
+ASIZE (Lisp_Object array)
+{
+ return XVECTOR (array)->header.size;
+}
+
+static inline void
+ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
+{
+ XVECTOR (array)->contents[idx] = val;
+}
+
/* If a struct is made to look like a vector, this macro returns the length
of the shortest vector that would hold that struct. */
#define VECSIZE(type) ((sizeof (type) \
@@ -810,53 +1011,6 @@
((offsetof (type, nonlispfield) - offsetof (struct Lisp_Vector, contents[0])) \
/ sizeof (Lisp_Object))
-/* A char-table is a kind of vectorlike, with contents are like a
- vector but with a few other slots. For some purposes, it makes
- sense to handle a char-table with type struct Lisp_Vector. An
- element of a char table can be any Lisp objects, but if it is a sub
- char-table, we treat it a table that contains information of a
- specific range of characters. A sub char-table has the same
- structure as a vector. A sub char table appears only in an element
- of a char-table, and there's no way to access it directly from
- Emacs Lisp program. */
-
-/* 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. */
-#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1)
-
-/* Return the number of "extra" slots in the char table CT. */
-
-#define CHAR_TABLE_EXTRA_SLOTS(CT) \
- (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
-
-#ifdef __GNUC__
-
-#define CHAR_TABLE_REF_ASCII(CT, IDX) \
- ({struct Lisp_Char_Table *_tbl = NULL; \
- Lisp_Object _val; \
- do { \
- _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \
- _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \
- : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \
- if (NILP (_val)) \
- _val = _tbl->defalt; \
- } while (NILP (_val) && ! NILP (_tbl->parent)); \
- _val; })
-
-#else /* not __GNUC__ */
-
-#define CHAR_TABLE_REF_ASCII(CT, IDX) \
- (! NILP (XCHAR_TABLE (CT)->ascii) \
- ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
- ? XCHAR_TABLE (CT)->ascii \
- : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \
- ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \
- : char_table_ref ((CT), (IDX))) \
- : char_table_ref ((CT), (IDX)))
-
-#endif /* not __GNUC__ */
-
/* Compute A OP B, using the unsigned comparison operator OP. A and B
should be integer expressions. This is not the same as
mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
@@ -870,31 +1024,23 @@
/* Nonzero iff C is an ASCII character. */
#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
-/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
- characters. Do not check validity of CT. */
-#define CHAR_TABLE_REF(CT, IDX) \
- (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \
- : char_table_ref ((CT), (IDX)))
-
-/* Almost equivalent to Faref (CT, IDX). However, if the result is
- not a character, return IDX.
-
- For these characters, do not check validity of CT
- and do not follow parent. */
-#define CHAR_TABLE_TRANSLATE(CT, IDX) \
- char_table_translate (CT, IDX)
-
-/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
- 8-bit European characters. Do not check validity of CT. */
-#define CHAR_TABLE_SET(CT, IDX, VAL) \
- (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
- ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
- : char_table_set (CT, IDX, VAL))
-
-#define CHARTAB_SIZE_BITS_0 6
-#define CHARTAB_SIZE_BITS_1 4
-#define CHARTAB_SIZE_BITS_2 5
-#define CHARTAB_SIZE_BITS_3 7
+/* A char-table is a kind of vectorlike, with contents are like a
+ vector but with a few other slots. For some purposes, it makes
+ sense to handle a char-table with type struct Lisp_Vector. An
+ element of a char table can be any Lisp objects, but if it is a sub
+ char-table, we treat it a table that contains information of a
+ specific range of characters. A sub char-table has the same
+ structure as a vector. A sub char table appears only in an element
+ of a char-table, and there's no way to access it directly from
+ Emacs Lisp program. */
+
+enum
+ {
+ CHARTAB_SIZE_BITS_0 = 6,
+ CHARTAB_SIZE_BITS_1 = 4,
+ CHARTAB_SIZE_BITS_2 = 5,
+ CHARTAB_SIZE_BITS_3 = 7
+ };
extern const int chartab_size[4];
@@ -951,6 +1097,70 @@
Lisp_Object contents[1];
};
+/* 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. */
+enum { CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1 };
+
+/* Return the number of "extra" slots in the char table CT. */
+
+static inline int
+CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
+{
+ return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK)
+ - CHAR_TABLE_STANDARD_SLOTS);
+}
+
+static inline Lisp_Object
+CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
+{
+ struct Lisp_Char_Table *tbl = NULL;
+ Lisp_Object val;
+ do
+ {
+ tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct);
+ val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii
+ : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]);
+ if (NILP (val))
+ val = tbl->defalt;
+ }
+ while (NILP (val) && ! NILP (tbl->parent));
+
+ return val;
+}
+
+/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
+ characters. Do not check validity of CT. */
+static inline Lisp_Object
+CHAR_TABLE_REF (Lisp_Object ct, int idx)
+{
+ return (ASCII_CHAR_P (idx)
+ ? CHAR_TABLE_REF_ASCII (ct, idx)
+ : char_table_ref (ct, idx));
+}
+
+/* Almost equivalent to Faref (CT, IDX). However, if the result is
+ not a character, return IDX.
+
+ For these characters, do not check validity of CT
+ and do not follow parent. */
+static inline int
+CHAR_TABLE_TRANSLATE (Lisp_Object ct, int idx)
+{
+ return char_table_translate (ct, idx);
+}
+
+/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
+ 8-bit European characters. Do not check validity of CT. */
+static inline void
+CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
+{
+ if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii))
+ XSUB_CHAR_TABLE (XCHAR_TABLE (ct)->ascii)->contents[idx] = val;
+ else
+ char_table_set (ct, idx, val);
+}
+
/* A boolvector is a kind of vectorlike, with contents are like a string. */
struct Lisp_Bool_Vector
{
@@ -1065,41 +1275,86 @@
/* Value is name of symbol. */
-#define SYMBOL_VAL(sym) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
-#define SYMBOL_ALIAS(sym) \
- (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
-#define SYMBOL_BLV(sym) \
- (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
-#define SYMBOL_FWD(sym) \
- (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
-#define SET_SYMBOL_VAL(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define SET_SYMBOL_ALIAS(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
-#define SET_SYMBOL_BLV(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
-#define SET_SYMBOL_FWD(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
+static inline Lisp_Object
+SYMBOL_VAL (struct Lisp_Symbol *sym)
+{
+ eassert (sym->redirect == SYMBOL_PLAINVAL);
+ return sym->val.value;
+}
+static inline struct Lisp_Symbol *
+SYMBOL_ALIAS (struct Lisp_Symbol *sym)
+{
+ eassert (sym->redirect == SYMBOL_VARALIAS);
+ return sym->val.alias;
+}
+static inline struct Lisp_Buffer_Local_Value *
+SYMBOL_BLV (struct Lisp_Symbol *sym)
+{
+ eassert (sym->redirect == SYMBOL_LOCALIZED);
+ return sym->val.blv;
+}
+static inline union Lisp_Fwd *
+SYMBOL_FWD (struct Lisp_Symbol *sym)
+{
+ eassert (sym->redirect == SYMBOL_FORWARDED);
+ return sym->val.fwd;
+}
+static inline void
+SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
+{
+ eassert (sym->redirect == SYMBOL_PLAINVAL);
+ sym->val.value = v;
+}
+static inline void
+SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
+{
+ eassert (sym->redirect == SYMBOL_VARALIAS);
+ sym->val.alias = v;
+}
+static inline void
+SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
+{
+ eassert (sym->redirect == SYMBOL_LOCALIZED);
+ sym->val.blv = v;
+}
+static inline void
+SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
+{
+ eassert (sym->redirect == SYMBOL_FORWARDED);
+ sym->val.fwd = v;
+}
-#define SYMBOL_NAME(sym) \
- LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
+static inline Lisp_Object
+SYMBOL_NAME (Lisp_Object sym)
+{
+ return XSYMBOL (sym)->xname;
+}
/* Value is non-zero if SYM is an interned symbol. */
-#define SYMBOL_INTERNED_P(sym) \
- (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
+static inline int
+SYMBOL_INTERNED_P (Lisp_Object sym)
+{
+ return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
+}
/* Value is non-zero if SYM is interned in initial_obarray. */
-#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
- (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
+static inline int
+SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
+{
+ return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
+}
/* Value is non-zero if symbol is considered a constant, i.e. its
value cannot be changed (there is an exception for keyword symbols,
whose value can be set to the keyword symbol itself). */
-#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
+static inline int
+SYMBOL_CONSTANT_P (Lisp_Object sym)
+{
+ return XSYMBOL (sym)->constant;
+}
#define DEFSYM(sym, name) \
do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
@@ -1181,16 +1436,25 @@
};
-#define XHASH_TABLE(OBJ) \
- ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
+static inline struct Lisp_Hash_Table *
+XHASH_TABLE (Lisp_Object a)
+{
+ return XUNTAG (a, Lisp_Vectorlike);
+}
#define XSET_HASH_TABLE(VAR, PTR) \
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
-#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE)
-
-#define CHECK_HASH_TABLE(x) \
- CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x)
+static inline int
+HASH_TABLE_P (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
+}
+static inline void
+CHECK_HASH_TABLE (Lisp_Object x)
+{
+ return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x);
+}
/* Value is the key part of entry IDX in hash table H. */
@@ -1215,12 +1479,14 @@
#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
/* Value is the size of hash table H. */
-
-#define HASH_TABLE_SIZE(H) ASIZE ((H)->next)
+static inline ptrdiff_t
+HASH_TABLE_SIZE (struct Lisp_Hash_Table *h)
+{
+ return ASIZE (h->next);
+}
/* Default size for hash tables if not specified. */
-
-#define DEFAULT_HASH_SIZE 65
+enum { DEFAULT_HASH_SIZE = 65 };
/* Default threshold specifying when to resize a hash table. The
value gives the ratio of current entries in the hash table and the
@@ -1340,6 +1606,43 @@
struct Lisp_Save_Value u_save_value;
};
+static inline union Lisp_Misc *
+XMISC (Lisp_Object a)
+{
+ return XUNTAG (a, Lisp_Misc);
+}
+
+static inline struct Lisp_Misc_Any *
+XMISCANY (Lisp_Object a)
+{
+ eassert (MISCP (a));
+ return & XMISC (a)->u_any;
+}
+
+/* A macro because it is also used as an lvalue. FIXME: clean this up. */
+#define XMISCTYPE(a) (XMISCANY (a)->type)
+
+static inline struct Lisp_Marker *
+XMARKER (Lisp_Object a)
+{
+ eassert (MARKERP (a));
+ return & XMISC (a)->u_marker;
+}
+
+static inline struct Lisp_Overlay *
+XOVERLAY (Lisp_Object a)
+{
+ eassert (OVERLAYP (a));
+ return & XMISC (a)->u_overlay;
+}
+
+static inline struct Lisp_Save_Value *
+XSAVE_VALUE (Lisp_Object a)
+{
+ eassert (SAVE_VALUEP (a));
+ return & XMISC (a)->u_save_value;
+}
+\f
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
and it means that the symbol's value really lives in the
@@ -1429,13 +1732,29 @@
Lisp_Object valcell;
};
-#define BLV_FOUND(blv) \
- (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
-#define SET_BLV_FOUND(blv, v) \
- (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
+static inline int
+BLV_FOUND (struct Lisp_Buffer_Local_Value *blv)
+{
+ eassert (blv->found == !EQ (blv->defcell, blv->valcell));
+ return blv->found;
+}
+static inline void
+SET_BLV_FOUND (struct Lisp_Buffer_Local_Value *blv, int v)
+{
+ eassert (v == !EQ (blv->defcell, blv->valcell));
+ blv->found = v;
+}
-#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
-#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
+static inline Lisp_Object
+BLV_VALUE (struct Lisp_Buffer_Local_Value *blv)
+{
+ return XCDR (blv->valcell);
+}
+static inline void
+SET_BLV_VALUE (struct Lisp_Buffer_Local_Value *blv, Lisp_Object v)
+{
+ XSETCDR (blv->valcell, v);
+}
/* Like Lisp_Objfwd except that value lives in a slot in the
current kboard. */
@@ -1453,6 +1772,47 @@
struct Lisp_Buffer_Objfwd u_buffer_objfwd;
struct Lisp_Kboard_Objfwd u_kboard_objfwd;
};
+
+static inline enum Lisp_Fwd_Type
+XFWDTYPE (union Lisp_Fwd *a)
+{
+ return a->u_intfwd.type;
+}
+
+static inline struct Lisp_Intfwd *
+XINTFWD (union Lisp_Fwd *a)
+{
+ eassert (INTFWDP (a));
+ return &a->u_intfwd;
+}
+
+static inline struct Lisp_Boolfwd *
+XBOOLFWD (union Lisp_Fwd *a)
+{
+ eassert (BOOLFWDP (a));
+ return &a->u_boolfwd;
+}
+
+static inline struct Lisp_Objfwd *
+XOBJFWD (union Lisp_Fwd *a)
+{
+ eassert (OBJFWDP (a));
+ return &a->u_objfwd;
+}
+
+static inline struct Lisp_Buffer_Objfwd *
+XBUFFER_OBJFWD (union Lisp_Fwd *a)
+{
+ eassert (BUFFER_OBJFWDP (a));
+ return &a->u_buffer_objfwd;
+}
+
+static inline struct Lisp_Kboard_Objfwd *
+XKBOARD_OBJFWD (union Lisp_Fwd *a)
+{
+ eassert (KBOARD_OBJFWDP (a));
+ return &a->u_kboard_objfwd;
+}
\f
/* Lisp floating point type. */
struct Lisp_Float
@@ -1468,13 +1828,24 @@
} u;
};
+static inline double
+XFLOAT_DATA (Lisp_Object f)
+{
#ifdef HIDE_LISP_IMPLEMENTATION
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data_ : XFLOAT (f)->u.data_)
+ return XFLOAT (f)->u.data_;
#else
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
+ return XFLOAT (f)->u.data;
+#endif
+}
+
+#ifndef HIDE_LISP_IMPLEMENTATION
/* This should be used only in alloc.c, which always disables
HIDE_LISP_IMPLEMENTATION. */
-#define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
+static inline void
+XFLOAT_INIT (Lisp_Object f, double n)
+{
+ XFLOAT (f)->u.data = n;
+}
#endif
/* A character, declared with the following typedef, is a member
@@ -1485,91 +1856,36 @@
#endif
/* Meanings of slots in a Lisp_Compiled: */
-
-#define COMPILED_ARGLIST 0
-#define COMPILED_BYTECODE 1
-#define COMPILED_CONSTANTS 2
-#define COMPILED_STACK_DEPTH 3
-#define COMPILED_DOC_STRING 4
-#define COMPILED_INTERACTIVE 5
+enum
+ {
+ COMPILED_ARGLIST,
+ COMPILED_BYTECODE,
+ COMPILED_CONSTANTS,
+ COMPILED_STACK_DEPTH,
+ COMPILED_DOC_STRING,
+ COMPILED_INTERACTIVE
+ };
/* Flag bits in a character. These also get used in termhooks.h.
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
(MUlti-Lingual Emacs) might need 22 bits for the character value
itself, so we probably shouldn't use any bits lower than 0x0400000. */
-#define CHAR_ALT (0x0400000)
-#define CHAR_SUPER (0x0800000)
-#define CHAR_HYPER (0x1000000)
-#define CHAR_SHIFT (0x2000000)
-#define CHAR_CTL (0x4000000)
-#define CHAR_META (0x8000000)
-
-#define CHAR_MODIFIER_MASK \
- (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META)
-
+enum
+ {
+ CHAR_ALT = 0x0400000,
+ CHAR_SUPER = 0x0800000,
+ CHAR_HYPER = 0x1000000,
+ CHAR_SHIFT = 0x2000000,
+ CHAR_CTL = 0x4000000,
+ CHAR_META = 0x8000000,
+ CHAR_MODIFIER_MASK =
+ CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META
+ };
/* Actually, the current Emacs uses 22 bits for the character value
itself. */
-#define CHARACTERBITS 22
-
-\f
-/* The glyph datatype, used to represent characters on the display.
- It consists of a char code and a face id. */
-
-typedef struct {
- int ch;
- int face_id;
-} GLYPH;
-
-/* Return a glyph's character code. */
-#define GLYPH_CHAR(glyph) ((glyph).ch)
-
-/* Return a glyph's face ID. */
-#define GLYPH_FACE(glyph) ((glyph).face_id)
-
-#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char))
-#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face))
-#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face))
-
-/* Return 1 if GLYPH contains valid character code. */
-#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph))
-
-
-/* Glyph Code from a display vector may either be an integer which
- encodes a char code in the lower CHARACTERBITS bits and a (very small)
- face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
-
-#define GLYPH_CODE_P(gc) \
- (CONSP (gc) \
- ? (CHARACTERP (XCAR (gc)) \
- && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \
- : (RANGED_INTEGERP \
- (0, gc, \
- (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \
- ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \
- : TYPE_MAXIMUM (EMACS_INT)))))
-
-/* The following are valid only if GLYPH_CODE_P (gc). */
-
-#define GLYPH_CODE_CHAR(gc) \
- (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1))
-
-#define GLYPH_CODE_FACE(gc) \
- (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS)
-
-#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
- do \
- { \
- if (CONSP (gc)) \
- SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
- else \
- SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
- (XINT (gc) >> CHARACTERBITS)); \
- } \
- while (0)
-
-/* The ID of the mode line highlighting face. */
-#define GLYPH_MODE_LINE_FACE 1
+enum { CHARACTERBITS = 22 };
+
\f
/* Structure to hold mouse highlight data. This is here because other
header files need it for defining struct x_output etc. */
@@ -1608,140 +1924,304 @@
\f
/* Data type checking */
-#define NILP(x) EQ (x, Qnil)
-
-#define NUMBERP(x) (INTEGERP (x) || FLOATP (x))
-#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0)
-
-#define RANGED_INTEGERP(lo, x, hi) \
- (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi))
+static inline int
+NILP (Lisp_Object x)
+{
+ return EQ (x, Qnil);
+}
+
+static inline int
+NUMBERP (Lisp_Object x)
+{
+ return INTEGERP (x) || FLOATP (x);
+}
+static inline int
+NATNUMP (Lisp_Object x)
+{
+ return INTEGERP (x) && 0 <= XINT (x);
+}
+
+static inline int
+RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi)
+{
+ return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi;
+}
+
#define TYPE_RANGED_INTEGERP(type, x) \
- (TYPE_SIGNED (type) \
- ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \
- : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type)))
-
-#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
-#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
-#define MISCP(x) (XTYPE ((x)) == Lisp_Misc)
-#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike)
-#define STRINGP(x) (XTYPE ((x)) == Lisp_String)
-#define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
-
-#define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
-#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG))
-#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
-#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
-#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
-
-#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
-#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
-#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
-#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
-#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
-
-/* True if object X is a pseudovector whose code is CODE. The cast to struct
- vectorlike_header * avoids aliasing issues. */
-#define PSEUDOVECTORP(x, code) \
- TYPED_PSEUDOVECTORP (x, vectorlike_header, code)
-
-#define PSEUDOVECTOR_TYPEP(v, code) \
- (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS)))
-
-/* True if object X, with internal type struct T *, is a pseudovector whose
- code is CODE. */
-#define TYPED_PSEUDOVECTORP(x, t, code) \
- (VECTORLIKEP (x) \
- && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code))
+ (INTEGERP (x) \
+ && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \
+ && XINT (x) <= TYPE_MAXIMUM (type))
+
+static inline int CONSP (Lisp_Object x) { return XTYPE (x) == Lisp_Cons; }
+static inline int FLOATP (Lisp_Object x) { return XTYPE (x) == Lisp_Float; }
+static inline int MISCP (Lisp_Object x) { return XTYPE (x) == Lisp_Misc; }
+static inline int STRINGP (Lisp_Object x) { return XTYPE (x) == Lisp_String; }
+static inline int SYMBOLP (Lisp_Object x) { return XTYPE (x) == Lisp_Symbol; }
+static inline int
+INTEGERP (Lisp_Object x)
+{
+ return LISP_INT_TAG_P (XTYPE (x));
+}
+static inline int
+VECTORLIKEP (Lisp_Object x)
+{
+ return XTYPE (x) == Lisp_Vectorlike;
+}
+static inline int
+VECTORP (Lisp_Object x)
+{
+ return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG);
+}
+static inline int
+OVERLAYP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay;
+}
+static inline int
+MARKERP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker;
+}
+static inline int
+SAVE_VALUEP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
+}
+
+static inline int
+INTFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Int;
+}
+static inline int
+BOOLFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Bool;
+}
+static inline int
+OBJFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Obj;
+}
+static inline int
+BUFFER_OBJFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
+}
+static inline int
+KBOARD_OBJFWDP (union Lisp_Fwd *a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
+}
+
+/* True if the size field SIZE of a pseudovector is that of a
+ pseudovector whose code is CODE. */
+static inline int
+PSEUDOVECTOR_SIZE_TYPEP (ptrdiff_t size, int code)
+{
+ return ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS)));
+}
+
+/* True if A is a pseudovector whose code is CODE. */
+static inline int
+PSEUDOVECTORP (Lisp_Object a, int code)
+{
+ if (! VECTORLIKEP (a))
+ return 0;
+ else
+ {
+ /* Converting to struct vectorlike_header * avoids aliasing issues. */
+ struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike);
+ return PSEUDOVECTOR_SIZE_TYPEP (h->size, code);
+ }
+}
+
/* Test for specific pseudovector types. */
-#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
-#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
-#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
-#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
+
+static inline int
+WINDOW_CONFIGURATIONP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION);
+}
+
+static inline int
+PROCESSP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_PROCESS);
+}
+
+static inline int
+WINDOWP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_WINDOW);
+}
+
+static inline int
+TERMINALP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_TERMINAL);
+}
+
/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */
-#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
-#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
-#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
-#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
-#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
-#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
-#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
+static inline int
+SUBRP (Lisp_Object a)
+{
+ if (! VECTORLIKEP (a))
+ return 0;
+ else
+ {
+ struct Lisp_Subr *h = XUNTAG (a, Lisp_Vectorlike);
+ return PSEUDOVECTOR_SIZE_TYPEP (h->size, PVEC_SUBR);
+ }
+}
+
+static inline int
+COMPILEDP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_COMPILED);
+}
+
+static inline int
+BUFFERP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_BUFFER);
+}
+
+static inline int
+CHAR_TABLE_P (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_CHAR_TABLE);
+}
+
+static inline int
+SUB_CHAR_TABLE_P (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE);
+}
+
+static inline int
+BOOL_VECTOR_P (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR);
+}
+
+static inline int
+FRAMEP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_FRAME);
+}
/* Test for image (image . spec) */
-#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
+static inline int
+IMAGEP (Lisp_Object x)
+{
+ return CONSP (x) && EQ (XCAR (x), Qimage);
+}
/* Array types. */
-
-#define ARRAYP(x) \
- (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
+static inline int
+ARRAYP (Lisp_Object x)
+{
+ return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x);
+}
\f
-#define CHECK_LIST(x) \
- CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
-
-#define CHECK_LIST_CONS(x, y) \
- CHECK_TYPE (CONSP (x), Qlistp, y)
-
-#define CHECK_LIST_END(x, y) \
- CHECK_TYPE (NILP (x), Qlistp, y)
-
-#define CHECK_STRING(x) \
- CHECK_TYPE (STRINGP (x), Qstringp, x)
-
-#define CHECK_STRING_CAR(x) \
- CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x))
-
-#define CHECK_CONS(x) \
- CHECK_TYPE (CONSP (x), Qconsp, x)
-
-#define CHECK_SYMBOL(x) \
- CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
-
-#define CHECK_CHAR_TABLE(x) \
- CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x)
-
-#define CHECK_VECTOR(x) \
- CHECK_TYPE (VECTORP (x), Qvectorp, x)
-
-#define CHECK_VECTOR_OR_STRING(x) \
- CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x)
-
-#define CHECK_ARRAY(x, Qxxxp) \
- CHECK_TYPE (ARRAYP (x), Qxxxp, x)
-
-#define CHECK_VECTOR_OR_CHAR_TABLE(x) \
- CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x)
-
-#define CHECK_BUFFER(x) \
- CHECK_TYPE (BUFFERP (x), Qbufferp, x)
-
-#define CHECK_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x), Qwindowp, x)
-
-#define CHECK_WINDOW_CONFIGURATION(x) \
- CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
-
-/* This macro rejects windows on the interior of the window tree as
- "dead", which is what we want; this is an argument-checking macro, and
- the user should never get access to interior windows.
-
- A window of any sort, leaf or interior, is dead if the buffer,
- vchild, and hchild members are all nil. */
-
-#define CHECK_LIVE_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x)
-
-#define CHECK_PROCESS(x) \
- CHECK_TYPE (PROCESSP (x), Qprocessp, x)
-
-#define CHECK_SUBR(x) \
- CHECK_TYPE (SUBRP (x), Qsubrp, x)
-
-#define CHECK_NUMBER(x) \
- CHECK_TYPE (INTEGERP (x), Qintegerp, x)
-
-#define CHECK_NATNUM(x) \
- CHECK_TYPE (NATNUMP (x), Qwholenump, x)
+static inline void
+CHECK_LIST (Lisp_Object x)
+{
+ CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x);
+}
+static inline void
+CHECK_LIST_CONS (Lisp_Object x, Lisp_Object y)
+{
+ CHECK_TYPE (CONSP (x), Qlistp, y);
+}
+static inline void
+CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
+{
+ CHECK_TYPE (NILP (x), Qlistp, y);
+}
+static inline void
+CHECK_STRING (Lisp_Object x)
+{
+ CHECK_TYPE (STRINGP (x), Qstringp, x);
+}
+static inline void
+CHECK_STRING_CAR (Lisp_Object x)
+{
+ CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
+}
+static inline void
+CHECK_CONS (Lisp_Object x)
+{
+ CHECK_TYPE (CONSP (x), Qconsp, x);
+}
+static inline void
+CHECK_SYMBOL (Lisp_Object x)
+{
+ CHECK_TYPE (SYMBOLP (x), Qsymbolp, x);
+}
+static inline void
+CHECK_CHAR_TABLE (Lisp_Object x)
+{
+ CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x);
+}
+static inline void
+CHECK_VECTOR (Lisp_Object x)
+{
+ CHECK_TYPE (VECTORP (x), Qvectorp, x);
+}
+static inline void
+CHECK_VECTOR_OR_STRING (Lisp_Object x)
+{
+ CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
+}
+static inline void
+CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp)
+{
+ CHECK_TYPE (ARRAYP (x), Qxxxp, x);
+}
+static inline void
+CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
+{
+ CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x);
+}
+static inline void
+CHECK_BUFFER (Lisp_Object x)
+{
+ CHECK_TYPE (BUFFERP (x), Qbufferp, x);
+}
+static inline void
+CHECK_WINDOW (Lisp_Object x)
+{
+ CHECK_TYPE (WINDOWP (x), Qwindowp, x);
+}
+static inline void
+CHECK_WINDOW_CONFIGURATION (Lisp_Object x)
+{
+ CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x);
+}
+static inline void
+CHECK_PROCESS (Lisp_Object x)
+{
+ CHECK_TYPE (PROCESSP (x), Qprocessp, x);
+}
+static inline void
+CHECK_SUBR (Lisp_Object x)
+{
+ CHECK_TYPE (SUBRP (x), Qsubrp, x);
+}
+static inline void
+CHECK_NUMBER (Lisp_Object x)
+{
+ CHECK_TYPE (INTEGERP (x), Qintegerp, x);
+}
+static inline void
+CHECK_NATNUM (Lisp_Object x)
+{
+ CHECK_TYPE (NATNUMP (x), Qwholenump, x);
+}
#define CHECK_RANGED_INTEGER(x, lo, hi) \
do { \
@@ -1762,57 +2242,76 @@
CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
} while (0)
-#define CHECK_MARKER(x) \
- CHECK_TYPE (MARKERP (x), Qmarkerp, x)
+static inline void
+CHECK_MARKER (Lisp_Object x)
+{
+ CHECK_TYPE (MARKERP (x), Qmarkerp, x);
+}
#define CHECK_NUMBER_COERCE_MARKER(x) \
do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
-#define XFLOATINT(n) extract_float((n))
-
-#define CHECK_FLOAT(x) \
- CHECK_TYPE (FLOATP (x), Qfloatp, x)
-
-#define CHECK_NUMBER_OR_FLOAT(x) \
- CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x)
+static inline double
+XFLOATINT (Lisp_Object n)
+{
+ return extract_float (n);
+}
+
+static inline void
+CHECK_FLOAT (Lisp_Object x)
+{
+ CHECK_TYPE (FLOATP (x), Qfloatp, x);
+}
+static inline void
+CHECK_NUMBER_OR_FLOAT (Lisp_Object x)
+{
+ CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x);
+}
#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \
else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
-#define CHECK_OVERLAY(x) \
- CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
+static inline void
+CHECK_OVERLAY (Lisp_Object x)
+{
+ CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
+}
/* Since we can't assign directly to the CAR or CDR fields of a cons
cell, use these when checking that those fields contain numbers. */
-#define CHECK_NUMBER_CAR(x) \
- do { \
- Lisp_Object tmp = XCAR (x); \
- CHECK_NUMBER (tmp); \
- XSETCAR ((x), tmp); \
- } while (0)
-
-#define CHECK_NUMBER_CDR(x) \
- do { \
- Lisp_Object tmp = XCDR (x); \
- CHECK_NUMBER (tmp); \
- XSETCDR ((x), tmp); \
- } while (0)
-
-#define CHECK_NATNUM_CAR(x) \
- do { \
- Lisp_Object tmp = XCAR (x); \
- CHECK_NATNUM (tmp); \
- XSETCAR ((x), tmp); \
- } while (0)
-
-#define CHECK_NATNUM_CDR(x) \
- do { \
- Lisp_Object tmp = XCDR (x); \
- CHECK_NATNUM (tmp); \
- XSETCDR ((x), tmp); \
- } while (0)
+static inline void
+CHECK_NUMBER_CAR (Lisp_Object x)
+{
+ Lisp_Object tmp = XCAR (x);
+ CHECK_NUMBER (tmp);
+ XSETCAR (x, tmp);
+}
+
+static inline void
+CHECK_NUMBER_CDR (Lisp_Object x)
+{
+ Lisp_Object tmp = XCDR (x);
+ CHECK_NUMBER (tmp);
+ XSETCDR (x, tmp);
+}
+
+static inline void
+CHECK_NATNUM_CAR (Lisp_Object x)
+{
+ Lisp_Object tmp = XCAR (x);
+ CHECK_NATNUM (tmp);
+ XSETCAR (x, tmp);
+}
+
+static inline void
+CHECK_NATNUM_CDR (Lisp_Object x)
+{
+ Lisp_Object tmp = XCDR (x);
+ CHECK_NATNUM (tmp);
+ XSETCDR (x, tmp);
+}
\f
/* Define a built-in function for calling from Lisp.
`lname' should be the name to give the function in Lisp,
@@ -1879,18 +2378,20 @@
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* Non-zero if OBJ is a Lisp function. */
-#define FUNCTIONP(OBJ) \
- ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
- || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
- || COMPILEDP (OBJ) \
- || SUBRP (OBJ))
+static inline int
+FUNCTIONP (Lisp_Object obj)
+{
+ return ((CONSP (obj) && EQ (XCAR (obj), Qlambda))
+ || (SYMBOLP (obj) && !NILP (Ffboundp (obj)))
+ || COMPILEDP (obj)
+ || SUBRP (obj));
+}
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defsubr (struct Lisp_Subr *);
-#define MANY -2
-#define UNEVALLED -1
+enum { MANY = -2, UNEVALLED = -1 };
extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
@@ -1983,7 +2484,11 @@
extern struct specbinding *specpdl_ptr;
extern ptrdiff_t specpdl_size;
-#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
+static inline ptrdiff_t
+SPECPDL_INDEX (void)
+{
+ return specpdl_ptr - specpdl;
+}
/* Everything needed to describe an active condition case. */
struct handler
@@ -2301,6 +2806,8 @@
#define EXFUN(fnname, maxargs) \
extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
+#include "globals.h"
+
/* Forward declarations for prototypes. */
struct window;
struct frame;
@@ -2334,6 +2841,7 @@
extern Lisp_Object Qinteger;
+extern Lisp_Object Qsubrp;
extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
@@ -2429,6 +2937,7 @@
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qstring_lessp;
extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
+extern Lisp_Object Qhash_table_p;
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
@@ -2714,7 +3223,7 @@
Lisp_Object);
extern Lisp_Object internal_with_output_to_temp_buffer
(const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
-#define FLOAT_TO_STRING_BUFSIZE 350
+enum { FLOAT_TO_STRING_BUFSIZE = 350 };
extern int float_to_string (char *, double);
extern void syms_of_print (void);
@@ -2737,10 +3246,12 @@
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
-#define LOADHIST_ATTACH(x) \
- do { \
- if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \
- } while (0)
+static inline void
+LOADHIST_ATTACH (Lisp_Object x)
+{
+ if (initialized)
+ Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
+}
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object *, Lisp_Object);
Lisp_Object string_to_number (char const *, int, int);
@@ -2858,6 +3369,7 @@
extern Lisp_Object Vbuffer_alist;
extern Lisp_Object set_buffer_if_live (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
+extern Lisp_Object Qoverlayp;
extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
extern struct buffer *all_buffers;
@@ -3015,10 +3527,10 @@
void synchronize_system_messages_locale (void);
void synchronize_system_time_locale (void);
#else
-#define setlocale(category, locale)
-#define fixup_locale()
-#define synchronize_system_messages_locale()
-#define synchronize_system_time_locale()
+static inline char *setlocale (int cat, char const *locale) { return 0; }
+static inline void fixup_locale (void) {}
+static inline void synchronize_system_messages_locale (void) {}
+static inline void synchronize_system_time_locale (void) {}
#endif
void shut_down_emacs (int, int, Lisp_Object);
/* Nonzero means don't do interactive redisplay and don't change tty modes. */
@@ -3281,19 +3793,19 @@
in addition to a device separator. Set the path separator
to '/', and don't test for a device separator in IS_ANY_SEP. */
-#define DIRECTORY_SEP '/'
+enum { DIRECTORY_SEP = '/' };
#ifndef IS_DIRECTORY_SEP
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
+static inline int IS_DIRECTORY_SEP (int c) { return c == DIRECTORY_SEP; }
#endif
#ifndef IS_DEVICE_SEP
#ifndef DEVICE_SEP
-#define IS_DEVICE_SEP(_c_) 0
+static inline int IS_DEVICE_SEP (int c) { return 0; }
#else
-#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
+static inline int IS_DEVICE_SEP (int c) { return c == DEVICE_SEP; }
#endif
#endif
#ifndef IS_ANY_SEP
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
+static inline int IS_ANY_SEP (int c) { return IS_DIRECTORY_SEP (c); }
#endif
#define SWITCH_ENUM_CAST(x) (x)
@@ -3313,15 +3825,6 @@
# define lint_assume(cond) ((void) (0 && (cond)))
#endif
-/* The ubiquitous min and max macros. */
-
-#ifdef max
-#undef max
-#undef min
-#endif
-#define min(a, b) ((a) < (b) ? (a) : (b))
-#define max(a, b) ((a) > (b) ? (a) : (b))
-
/* We used to use `abs', but that clashes with system headers on some
platforms, and using a name reserved by Standard C is a bad idea
anyway. */
@@ -3364,7 +3867,7 @@
/* SAFE_ALLOCA normally allocates memory on the stack, but if size is
larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
-#define MAX_ALLOCA 16*1024
+enum { MAX_ALLOCA = 16*1024 };
extern Lisp_Object safe_alloca_unwind (Lisp_Object);
@@ -3433,7 +3936,4 @@
memory_full (SIZE_MAX); \
} while (0)
-
-#include "globals.h"
-
#endif /* EMACS_LISP_H */
=== modified file 'src/mem-limits.h'
--- src/mem-limits.h 2012-07-09 16:38:45 +0000
+++ src/mem-limits.h 2012-07-13 03:37:42 +0000
@@ -36,9 +36,7 @@
extern char *start_of_data (void) ATTRIBUTE_CONST;
#if USE_LSB_TAG || UINTPTR_MAX <= VAL_MAX
#define EXCEEDS_LISP_PTR(ptr) 0
-#elif defined DATA_SEG_BITS
+#else
#define EXCEEDS_LISP_PTR(ptr) \
(((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS)
-#else
-#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS)
#endif
=== modified file 'src/window.c'
--- src/window.c 2012-07-10 16:53:26 +0000
+++ src/window.c 2012-07-13 03:37:42 +0000
@@ -51,8 +51,8 @@
#include "nsterm.h"
#endif
-Lisp_Object Qwindowp, Qwindow_live_p;
-static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer;
+Lisp_Object Qwindowp, Qwindow_live_p, Qwindow_configuration_p;
+static Lisp_Object Qrecord_window_buffer;
static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer;
static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window;
static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically;
=== modified file 'src/window.h'
--- src/window.h 2012-07-05 15:20:12 +0000
+++ src/window.h 2012-07-13 03:37:42 +0000
@@ -885,7 +885,7 @@
/* These used to be in lisp.h. */
-extern Lisp_Object Qwindowp, Qwindow_live_p;
+extern Lisp_Object Qwindow_live_p;
extern Lisp_Object Vwindow_list;
extern int compare_window_configurations (Lisp_Object, Lisp_Object, int);
@@ -900,4 +900,17 @@
extern void syms_of_window (void);
extern void keys_of_window (void);
+/* CHECK_LIVE_WINDOW rejects windows on the interior of the window tree as
+ "dead", which is what we want; this is an argument-checking function, and
+ the user should never get access to interior windows.
+
+ A window of any sort, leaf or interior, is dead if the buffer,
+ vchild, and hchild members are all nil. */
+static inline void
+CHECK_LIVE_WINDOW (Lisp_Object x)
+{
+ CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x);
+}
+
+
#endif /* not WINDOW_H_INCLUDED */
^ permalink raw reply [flat|nested] 41+ messages in thread* bug#11935: [TRUNCATED MESSAGE 2746 87596] bug#11935: XINT etc. should be functions 2012-07-13 15:07 bug#11935: XINT etc. should be functions Paul Eggert @ 2012-07-14 2:20 ` Richard Stallman 2012-07-15 13:41 ` Paul Eggert 2012-07-15 14:41 ` Chong Yidong ` (2 subsequent siblings) 3 siblings, 1 reply; 41+ messages in thread From: Richard Stallman @ 2012-07-14 2:20 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 In the old days Emacs had to use macros for this sort of thing, because C compilers generated significantly faster code with macros. Modern C compilers, however, don't have this problem. That could be true if the functions are inlined. How does this change affect performance with -O0? -- Dr Richard Stallman President, Free Software Foundation 51 Franklin St Boston MA 02110 USA www.fsf.org www.gnu.org Skype: No way! That's nonfree (freedom-denying) software. Use Ekiga or an ordinary phone call ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-14 2:20 ` bug#11935: [TRUNCATED MESSAGE 2746 87596] " Richard Stallman @ 2012-07-15 13:41 ` Paul Eggert 2012-07-15 22:06 ` Stefan Monnier 2012-07-16 18:19 ` Richard Stallman 0 siblings, 2 replies; 41+ messages in thread From: Paul Eggert @ 2012-07-15 13:41 UTC (permalink / raw) To: rms; +Cc: 11935 On 07/13/2012 07:20 PM, Richard Stallman wrote: > How does this change affect performance with -O0? It hurts it. In normal operation I don't notice -- everything is plenty fast enough -- but in an artificial benchmark designed to stress the new code (see below) the performance is significantly worse. If this is an issue, we can mark these new functions with __attribute__ ((__always_inline__)), but I'm inclined to try things without this attribute, and resort to the attribute only if needed. I did two measures of performance. "text" simply counts the number of bytes in the text segment. "bench" counts the number of CPU seconds consumed by running the benchmark described below. "current" refers to trunk bzr 109093, and "patched" to that bzr after the proposed patch is applied. In both cases I've normalized the numbers to the current default (so it scores as 1), and smaller numbers are better. text bench 1.000 1.00 current (default optimization) 0.995 0.99 patched (default optimization) 1.332 1.82 current (-O0) 1.410 11.86 patched (-O0) My benchmark was (benchmark 100000), with the following code, byte-compiled. My platform is Fedora 15 x86-64, compiled with GCC 4.7.1. Benchmark timings are sloppy, as usual, so I wouldn't attach much significance past the first couple of digits. (defvar longlist '(a b c d e f g h i j k l m n o p q r s t u v w x y z)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (setq longlist (append longlist longlist)) (defvar x) (defun benchmark-with (n) (let ((start (float-time (get-internal-run-time))) (v (make-vector 1 0)) (i 0)) (while (< i n) (setq x (nth 8000 longlist)) (setq i (1+ i))) (- (float-time (get-internal-run-time)) start))) (defun benchmark-without (n) (let ((start (float-time (get-internal-run-time))) (v (make-vector 1 0)) (i 0)) (while (< i n) (setq i (1+ i))) (- (float-time (get-internal-run-time)) start))) (defun benchmark (n) (- (benchmark-with n) (benchmark-without n))) ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-15 13:41 ` Paul Eggert @ 2012-07-15 22:06 ` Stefan Monnier 2012-07-16 14:54 ` Paul Eggert 2012-07-16 18:19 ` Richard Stallman 1 sibling, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2012-07-15 22:06 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935, rms >> How does this change affect performance with -O0? > It hurts it. In normal operation I don't notice -- > everything is plenty fast enough -- but in an artificial > benchmark designed to stress the new code (see below) the > performance is significantly worse. If this is an issue, > we can mark these new functions with __attribute__ > ((__always_inline__)), but I'm inclined to try things > without this attribute, and resort to the attribute only if > needed. I always run with -O0 (plus ENABLE_CHECKING, and to add insult to injury, on Atom-level platforms), so I'd appreciate if you could ensure those functions are inlined even in -O0. > 1.332 1.82 current (-O0) > 1.410 11.86 patched (-O0) That would really hurt: my Emacs sessions already tend to feel sluggish without this extra pain. Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-15 22:06 ` Stefan Monnier @ 2012-07-16 14:54 ` Paul Eggert 2012-07-16 16:12 ` Eli Zaretskii 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2012-07-16 14:54 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935, rms On 07/15/2012 03:06 PM, Stefan Monnier wrote: > I always run with -O0 (plus ENABLE_CHECKING, and to add insult to > injury, on Atom-level platforms), so I'd appreciate if you could ensure > those functions are inlined even in -O0. That's easy enough to arrange, without being intrusive -- it would add maybe 10 lines to the patch. Although the benchmark numbers are a bit scary, they greatly exaggerate the real-life performance effect, because most of Emacs's CPU time is spent elsewhere. I just now ran Emacs with the patch compiled with -g -O0, on my main laptop, which is also quite limited and slow (Pentium M 1.86 GHz, circa 2005), and interactive performance was fine. Your mileage may vary, of course, but it might make sense to not inline those functions even with -O0. There are important advantages to not inlining: you can put breakpoints on them, for example. So it might make sense to inline them only as an option. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-16 14:54 ` Paul Eggert @ 2012-07-16 16:12 ` Eli Zaretskii 2012-07-16 21:40 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Eli Zaretskii @ 2012-07-16 16:12 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935, rms > Date: Mon, 16 Jul 2012 07:54:07 -0700 > From: Paul Eggert <eggert@cs.ucla.edu> > Cc: 11935@debbugs.gnu.org, rms@gnu.org > > There are important advantages to not inlining: you can put > breakpoints on them, for example. Why would we need to put a breakpoint on a function that replaces the XINT macro? We've lived with a macro (where you cannot put a breakpoint) for many years without any problems (AFAIK). We have debugger commands to display values of Lisp integers. So I don't think debuggability will be a problem in this particular case (although it might be in others). ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-16 16:12 ` Eli Zaretskii @ 2012-07-16 21:40 ` Paul Eggert 0 siblings, 0 replies; 41+ messages in thread From: Paul Eggert @ 2012-07-16 21:40 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 11935, rms On 07/16/2012 09:12 AM, Eli Zaretskii wrote: > Why would we need to put a breakpoint on a function that replaces the > XINT macro? I was thinking more of larger macros like CHAR_TABLE_REF_ASCII, where it can be helpful to step through the interior loop. This cannot be done easily right now -- I typically drop into machine code, which is painful. Even for XINT, it can be helpful (for a beginner, anyway) to step through a function, for example, to see what happens with integers that are out of range for Emacs fixnums. I know that Emacs has gdb macros that substitute for straightforward commands to print expressions, and these are useful for the long-time Emacs experts who know about them, but it'd be nicer if debugging also worked in the usual way without requiring this additional expertise. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-15 13:41 ` Paul Eggert 2012-07-15 22:06 ` Stefan Monnier @ 2012-07-16 18:19 ` Richard Stallman 2012-07-16 22:46 ` Paul Eggert 1 sibling, 1 reply; 41+ messages in thread From: Richard Stallman @ 2012-07-16 18:19 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 It hurts it. In normal operation I don't notice -- everything is plenty fast enough My machine is a lot slower than yours; I think this will be a big problem. Please set them up to always inline. There can be a macro switch to turn that off with -D. -- Dr Richard Stallman President, Free Software Foundation 51 Franklin St Boston MA 02110 USA www.fsf.org www.gnu.org Skype: No way! That's nonfree (freedom-denying) software. Use Ekiga or an ordinary phone call ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-16 18:19 ` Richard Stallman @ 2012-07-16 22:46 ` Paul Eggert 2012-07-17 3:04 ` Eli Zaretskii 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2012-07-16 22:46 UTC (permalink / raw) To: rms; +Cc: 11935 On 07/16/2012 11:19 AM, Richard Stallman wrote: > Please set them up to always inline. There can be > a macro switch to turn that off with -D. Sure, that's easy. I plan to incorporate something like the patch below, which uses -DINLINING=0 to turn it off (default is INLINING=1). === modified file 'ChangeLog' --- ChangeLog 2012-07-16 06:49:45 +0000 +++ ChangeLog 2012-07-16 22:35:32 +0000 @@ -3,6 +3,9 @@ Use functions, not macros, for XINT etc. * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, as it generates bogus warnings about reasonable casts of calls. + (ALWAYS_INLINE): New macro. + (inline): Define to 'ALWAYS_INLINE' when compiling with GCC without + optimization, and without -DINLINING=0. 2012-07-15 Paul Eggert <eggert@cs.ucla.edu> === modified file 'configure.ac' --- configure.ac 2012-07-15 00:33:12 +0000 +++ configure.ac 2012-07-16 22:21:37 +0000 @@ -4238,6 +4238,25 @@ #include <string.h> #include <stdlib.h> +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 2) +# define ALWAYS_INLINE __attribute__ ((__always_inline__)) +#else +# define ALWAYS_INLINE +#endif + +/* When compiling via GCC without optimization, and without -DINLINING=0, + always inline functions marked 'inline'. This typically improves CPU + performance when debugging. With optimization, trust the compiler + to inline as appropriate. */ +#ifndef INLINING +# define INLINING 1 +#endif +#if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ + && INLINING && !defined inline) +# define inline ALWAYS_INLINE +#endif + #if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */ #define NO_INLINE __attribute__((noinline)) #else ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-16 22:46 ` Paul Eggert @ 2012-07-17 3:04 ` Eli Zaretskii 2012-07-17 3:54 ` Paul Eggert 2012-07-24 2:20 ` Paul Eggert 0 siblings, 2 replies; 41+ messages in thread From: Eli Zaretskii @ 2012-07-17 3:04 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935, rms > Date: Mon, 16 Jul 2012 15:46:31 -0700 > From: Paul Eggert <eggert@cs.ucla.edu> > Cc: 11935@debbugs.gnu.org > > +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 2) > +# define ALWAYS_INLINE __attribute__ ((__always_inline__)) > +#else > +# define ALWAYS_INLINE > +#endif > + > +/* When compiling via GCC without optimization, and without -DINLINING=0, > + always inline functions marked 'inline'. This typically improves CPU > + performance when debugging. With optimization, trust the compiler > + to inline as appropriate. */ > +#ifndef INLINING > +# define INLINING 1 > +#endif > +#if (defined __NO_INLINE__ \ > + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ > + && INLINING && !defined inline) > +# define inline ALWAYS_INLINE > +#endif > + Wouldn't this inline all the functions declared 'inline'? If so, that's going too far, IMO. I think we need a facility for doing this only with a few functions that affect performance. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-17 3:04 ` Eli Zaretskii @ 2012-07-17 3:54 ` Paul Eggert 2012-07-24 2:20 ` Paul Eggert 1 sibling, 0 replies; 41+ messages in thread From: Paul Eggert @ 2012-07-17 3:54 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 11935, rms On 07/16/2012 08:04 PM, Eli Zaretskii wrote: > Wouldn't this inline all the functions declared 'inline'? No, only the functions defined after the macro. <string.h> functions, for example, are unaffected. > I think we need a facility for doing this > only with a few functions that affect performance. I considered that (with a macro "Inline"), but it'd complicate maintenance. I hope that the simpler approach is good enough. If not, we can revisit this, and quite possibly if we do that we'll do "Inline" or something like it. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-17 3:04 ` Eli Zaretskii 2012-07-17 3:54 ` Paul Eggert @ 2012-07-24 2:20 ` Paul Eggert 2012-07-24 9:07 ` Stefan Monnier 1 sibling, 1 reply; 41+ messages in thread From: Paul Eggert @ 2012-07-24 2:20 UTC (permalink / raw) To: 11935 [-- Attachment #1: Type: text/plain, Size: 1061 bytes --] On 07/16/2012 08:04 PM, Eli Zaretskii wrote: > we need a facility for doing this > only with a few functions that affect performance. It turns out that when compiling with -O0, always_inline functions are often slower than macros, as the inlined code also contains unnecessary instructions to copy arguments and results. So instead of using always_inline, it's better to do this performance-critical inlining by hand. I did that (patch relative to trunk bzr 109195 attached), inlining enough so that CPU performance improved by 8.7% compared to the current trunk, when compiled with gcc -O0. (This is the same benchmark as before, on x86-64 with GCC 4.7.1.) The performance win is because I inlined a bit more cleverly than the current code does. Like the earlier version, this patch should improve performance slightly in the default-optimization case too, since this patch is identical to the earlier one when default optimization is used. In short, it should take only a relatively small amount of hand-inlining to address the -O0 performance issue. [-- Attachment #2: inline-diff.txt --] [-- Type: text/plain, Size: 83203 bytes --] === modified file 'ChangeLog' --- ChangeLog 2012-07-17 07:30:25 +0000 +++ ChangeLog 2012-07-24 02:00:33 +0000 @@ -1,3 +1,9 @@ +2012-07-24 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + 2012-07-17 Dmitry Antipov <dmantipov@yandex.ru> Fix toolkit configuration report. === modified file 'configure.ac' --- configure.ac 2012-07-17 07:30:25 +0000 +++ configure.ac 2012-07-17 16:27:20 +0000 @@ -675,6 +675,7 @@ nw="$nw -Winline" # OK to ignore 'inline' nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-23 16:57:20 +0000 +++ src/ChangeLog 2012-07-24 02:00:33 +0000 @@ -1,3 +1,132 @@ +2012-07-24 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + In lisp.h, prefer functions to function-like macros, and + constants to object-like macros, when either will do. This: + . makes the code easier to debug, as the symbols are visible to GDB. + . simplifies use, as there's no more need to worry about + arguments' side effects being evaluated multiple times. + . shrinks the size of Emacs's text segment by 0.5% + on my platform (x86-64, GCC 4.7.1). + * buffer.c (Qoverlap): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + Now extern, so lisp.h can use these symbols. + * dispextern.h: Include character.h, for MAX_CHAR etc. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move here from lisp.h. + (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. + (GLYPH_MODE_LINE_FACE): Now enums, not macros. + * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since + XUNTAG now returns void *. + * lisp.h (XLI, XIL, CHECK_TYPE, CHECK_LIST_CONS, CHECK_NUMBER) + (CHECK_SYMBOL, CONSP, EQ, FLOATP, INTEGERP, LISP_INT_TAG_P, MARKERP) + (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) + (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): + If compiling via GCC without optimization, inline these functions + manually, by defining macros in addition to inline functions. + To disable this, compile with -DINLINING=0. + (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but + hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. + (CHECK_CONS_LIST, LISP_INT_TAG_P, XLI, XIL, XHASH, XTYPE) + (XINT, XFASTINT, XUINT, make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR) + (XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR) + (XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR, CHECK_TYPE) + (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) + (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, STRING_INTERVALS) + (STRING_SET_INTERVALS, SDATA, SSDATA, SREF, SSET, SCHARS) + (STRING_BYTES, SBYTES, STRING_SET_CHARS, ASIZE, ASET) + (CHAR_TABLE_EXTRA_SLOTS, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) + (CHAR_TABLE_TRANSLATE, CHAR_TABLE_SET, SYMBOL_VAL, SYMBOL_ALIAS) + (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) + (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) + (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) + (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_TABLE_SIZE) + (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XSETMISCTYPE) + (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE, XFWDTYPE) + (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) + (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) + (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) + (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) + (MARKERP, SAVE_VALUEP, INTFWDP, BOOLFWDP, OBJFWDP) + (BUFFER_OBJFWDP, KBOARD_OBJFWDP) + (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) + (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) + (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) + (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) + (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) + (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) + (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) + (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) + (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) + (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) + (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) + (IS_DIRECTORY_SEP, IS_DEVICE_SEP, IS_ANY_SEP): + Now static inline functions. + (PSEUDOVECTOR_SIZE_TYPEP) New static inline function, replacing ... + (PSEUDOVECTOR_TYPEP): Remove macro. All uses changed to the new API. + (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. + (EMACS_INT, EMACS_UINT): Now typedefs, not macros. + (VALBITS, INTTYPEBITS, FIXNUM_BITS, LISP_INT_TAG) + (PSEUDOVECTOR_SIZE_BITS, PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK) + (BOOL_VECTOR_BITS_PER_CHAR, CHAR_TABLE_STANDARD_SLOTS) + (CHARTAB_SIZE_BITS_0, CHARTAB_SIZE_BITS_1) + (CHARTAB_SIZE_BITS_2, CHARTAB_SIZE_BITS_3, DEFAULT_HASH_SIZE) + (COMPILED_ARGLIST, COMPILED_BYTECODE, COMPILED_CONSTANTS) + (COMPILED_STACK_DEPTH, COMPILED_DOC_STRING, COMPILED_INTERACTIVE) + (CHAR_ALT, CHAR_SUPER, CHAR_HYPER, CHAR_SHIFT, CHAR_CTL, CHAR_META) + (CHAR_MODIFIER_MASK, MANY, UNEVALLED, FLOAT_TO_STRING_BUFSIZE): + (DIRECTORY_SEP, MAX_ALLOCA): + Now constants, not macros. + (LISP_INT1_TAG, LISP_STRING_TAG, LISP_MAKE_RVALUE, TYPEMASK): + Remove; no longer needed. + (DATA_SEG_BITS): Default to 0, as this simplifies the rest of the code. + (VALMASK): Define in one place rather than in two, merging the + USE_LSB_TAG parts; this is simpler. + (MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM, max, min) + (struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): + Move up, to avoid use before definition. + Also include "globals.h" earlier, for the same reason. + (make_natnum, xtag): New functions. + (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. + (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) + (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) + (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) + (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) + (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) + (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) + (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) + (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) + (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) + (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) + (Qwindow_configuration_p, Qimage): New forward declarations. + (XSET): Simplify by rewriting in terms of xtag. + (XSETFASTINT): Simplify by rewriting in terms of make_natnum. + (STRING_COPYIN): Remove; unused. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. + (TYPE_RANGED_INTEGERP): Simplify. + (PSEUDOVECTOR_SIZE_TYPEP): Rename from PSEUDOVECTORP_TYPEP and + change the first arg to be a size rather than a pointer, + to make it usable as a function. All uses changed. + (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. + (setlocale, fixup_locale, synchronize_system_messages_locale) + (synchronize_system_time_locale) [!HAVE_SETLOCALE]: + Now empty functions, not macros. + * mem-limits.h (EXCEEDS_LISP_PTR) [!defined DATA_SEG_BITS]: + Remove, as DATA_SEG_BITS is always defined now, if only to zero. + * window.c (Qwindow_configuration_p): + Now extern, so window.h can use it. + * window.h (Qwindowp): Move decl back to lisp.h. + (CHECK_LIVE_WINDOW): Move here from lisp.h, so window.h internals + need not be moved to lisp.h. Now a function, not a macro. + 2012-07-23 Eli Zaretskii <eliz@gnu.org> * print.c (print_object): Don't crash when a frame's name is nil === modified file 'src/alloc.c' --- src/alloc.c 2012-07-23 11:15:43 +0000 +++ src/alloc.c 2012-07-23 21:58:10 +0000 @@ -3074,12 +3074,12 @@ + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) /* Number of bytes used by vector-block-allocated object. This is the only - place where we actually use the `nbytes' field of the vector-header. - I.e. we could get rid of the `nbytes' field by computing it based on the + place where we actually use the 'size' field of the vector-header. + I.e. we could get rid of the 'size' field by computing it based on the vector-type. */ #define PSEUDOVECTOR_NBYTES(vector) \ - (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \ + (PSEUDOVECTOR_SIZE_TYPEP (vector->header.size, PVEC_FREE) \ ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \ : vector->header.next.nbytes) @@ -3171,7 +3171,8 @@ /* All non-bool pseudovectors are small enough to be allocated from vector blocks. This code should be redesigned if some pseudovector type grows beyond VBLOCK_BYTES_MAX. */ - eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR)); + eassert (PSEUDOVECTOR_SIZE_TYPEP (vector->header.size, + PVEC_BOOL_VECTOR)); total_vector_slots += (bool_header_size @@ -4392,7 +4393,7 @@ while (VECTOR_IN_BLOCK (vector, block) && vector <= (struct Lisp_Vector *) p) { - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) + if (PSEUDOVECTOR_SIZE_TYPEP (vector->header.size, PVEC_FREE)) vector = ADVANCE (vector, (vector->header.size & PSEUDOVECTOR_SIZE_MASK)); else if (vector == p) === modified file 'src/buffer.c' --- src/buffer.c 2012-07-23 11:15:43 +0000 +++ src/buffer.c 2012-07-23 21:50:36 +0000 @@ -139,7 +139,7 @@ static Lisp_Object Qget_file_buffer; -static Lisp_Object Qoverlayp; +Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; === modified file 'src/data.c' --- src/data.c 2012-07-19 22:35:58 +0000 +++ src/data.c 2012-07-23 21:50:36 +0000 @@ -91,7 +91,8 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -static Lisp_Object Qsubrp, Qmany, Qunevalled; +Lisp_Object Qsubrp; +static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; === modified file 'src/dispextern.h' --- src/dispextern.h 2012-07-13 03:50:58 +0000 +++ src/dispextern.h 2012-07-13 03:52:53 +0000 @@ -22,6 +22,8 @@ #ifndef DISPEXTERN_H_INCLUDED #define DISPEXTERN_H_INCLUDED +#include "character.h" + #ifdef HAVE_X_WINDOWS #include <X11/Xlib.h> @@ -265,6 +267,55 @@ Glyphs ***********************************************************************/ +/* The glyph datatype, used to represent characters on the display. + It consists of a char code and a face id. */ + +typedef struct { + int ch; + int face_id; +} GLYPH; + +/* Return a glyph's character code. */ +static inline int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } + +/* Return a glyph's face ID. */ +static inline int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } + +#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) +#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) +#define SET_GLYPH(glyph, char, face) \ + ((glyph).ch = (char), (glyph).face_id = (face)) + +/* The following are valid only if GLYPH_CODE_P (gc). */ + +static inline int +GLYPH_CODE_CHAR (Lisp_Object gc) +{ + return (CONSP (gc) + ? XINT (XCAR (gc)) + : XINT (gc) & MAX_CHAR); +} + +static inline int +GLYPH_CODE_FACE (Lisp_Object gc) +{ + return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; +} + +#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ + do \ + { \ + if (CONSP (gc)) \ + SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + else \ + SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ + (XINT (gc) >> CHARACTERBITS)); \ + } \ + while (0) + +/* The ID of the mode line highlighting face. */ +enum { GLYPH_MODE_LINE_FACE = 1 }; + /* Enumeration of glyph types. Glyph structures contain a type field containing one of the enumerators defined here. */ @@ -1763,6 +1814,30 @@ #endif /* not HAVE_WINDOW_SYSTEM */ +/* Return 1 if G contains a valid character code. */ +static inline int +GLYPH_CHAR_VALID_P (GLYPH g) +{ + return CHAR_VALID_P (GLYPH_CHAR (g)); +} + +/* The glyph code from a display vector may either be an integer which + encodes a char code in the lower CHARACTERBITS bits and a (very small) + face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ + +static inline int +GLYPH_CODE_P (Lisp_Object gc) +{ + return (CONSP (gc) + ? (CHARACTERP (XCAR (gc)) + && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_INTEGERP + (0, gc, + (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR + : TYPE_MAXIMUM (EMACS_INT))))); +} + /* Non-zero means face attributes have been changed since the last redisplay. Used in redisplay_internal. */ === modified file 'src/eval.c' --- src/eval.c 2012-07-20 05:28:00 +0000 +++ src/eval.c 2012-07-23 21:50:36 +0000 @@ -1919,7 +1919,7 @@ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_number (XUNTAG (function, Lisp_Symbol)); + docstring = make_number ((intptr_t) XUNTAG (function, Lisp_Symbol)); return Ffset (function, Fpurecopy (list5 (Qautoload, file, docstring, interactive, type))); === modified file 'src/fns.c' --- src/fns.c 2012-07-20 07:29:04 +0000 +++ src/fns.c 2012-07-23 21:50:36 +0000 @@ -3354,7 +3354,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue; +Lisp_Object Qhash_table_p; +static Lisp_Object Qkey, Qvalue; Lisp_Object Qeq, Qeql, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; === modified file 'src/lisp.h' --- src/lisp.h 2012-07-23 11:15:43 +0000 +++ src/lisp.h 2012-07-24 01:57:18 +0000 @@ -32,10 +32,10 @@ #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); -#define CHECK_CONS_LIST() check_cons_list () #else -#define CHECK_CONS_LIST() ((void) 0) +static inline void check_cons_list (void) { } #endif +static inline void CHECK_CONS_LIST (void) { check_cons_list (); } /* Temporarily disable wider-than-pointer integers until they're tested more. Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */ @@ -45,22 +45,24 @@ 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 +#ifndef EMACS_INT_MAX # if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT -# define EMACS_INT long long +typedef long long int EMACS_INT; +typedef unsigned long long int EMACS_UINT; # define EMACS_INT_MAX LLONG_MAX # define pI "ll" # elif INT_MAX < LONG_MAX -# define EMACS_INT long +typedef long int EMACS_INT; +typedef unsigned long int EMACS_UINT; # define EMACS_INT_MAX LONG_MAX # define pI "l" # else -# define EMACS_INT int +typedef int EMACS_INT; +typedef unsigned int EMACS_UINT; # define EMACS_INT_MAX INT_MAX # define pI "" # endif #endif -#define EMACS_UINT unsigned EMACS_INT /* Number of bits in some machine integer types. */ enum @@ -153,8 +155,10 @@ variable VAR of type TYPE with the added requirement that it be TYPEBITS-aligned. */ +/* Number of bits in a Lisp_Obect tag. This can be used in #if. */ #define GCTYPEBITS 3 -#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS) + +enum { VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS }; /* 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. @@ -210,20 +214,72 @@ #endif +/* When compiling via GCC without optimization, inline a few functions + manually, as Emacs is too slow otherwise. There's no need to + inline everything, just the functions that would cause a serious + performance problem when debugging. To disable this hand-optimization, + compile with -DINLINING=0. + + Commentary for these macros can be found near their corresponding + functions, below. */ +#if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ + && ! (defined INLINING && ! INLINING)) +# if CHECK_LISP_OBJECT_TYPE +# define XLI(o) (o).i +# define XIL(i) (Lisp_Object) { i } +# else +# define XLI(o) (o) +# define XIL(i) (i) +# endif +# define CHECK_TYPE(ok, Qxxxp, x) \ + ((void) ((ok) || wrong_type_argument (Qxxxp, x))) +# define CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) +# define CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) +# define CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) +# define CONSP(x) (XTYPE (x) == Lisp_Cons) +# define EQ(a, b) (XHASH (a) == XHASH (b)) +# define FLOATP(x) (XTYPE (x) == Lisp_Float) +# define INTEGERP(x) LISP_INT_TAG_P (XTYPE (x)) +# define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) +# define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) +# define MISCP(x) (XTYPE (x) == Lisp_Misc) +# define NILP(x) EQ (x, Qnil) +# define SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +# define SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +# define SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) +# define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) +# define VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +# define XCAR(c) XCAR_AS_LVALUE (c) +# define XCDR(c) XCDR_AS_LVALUE (c) +# define XCONS(a) \ + (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +# define XHASH(o) XLI (o) +# define XPNTR(a) ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) +# define XSYMBOL(a) \ + (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +# if USE_LSB_TAG +# define make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS) +# define XFASTINT(a) XINT (a) +# define XINT(a) (XLI (a) >> INTTYPEBITS) +# define XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) +# define XUNTAG(a, type) ((void *) (XLI (a) - (type))) +# endif +#endif + + /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. */ /* 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 INTTYPEBITS (GCTYPEBITS - 1) -#define FIXNUM_BITS (VALBITS + 1) +enum { INTTYPEBITS = GCTYPEBITS - 1 }; +enum { FIXNUM_BITS = VALBITS + 1 }; #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) -#define LISP_INT_TAG Lisp_Int0 #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 -#define LISP_INT1_TAG (USE_LSB_TAG ? 1 << INTTYPEBITS : 1) -#define LISP_STRING_TAG (5 - LISP_INT1_TAG) -#define LISP_INT_TAG_P(x) (((x) & ~LISP_INT1_TAG) == 0) /* Stolen from GDB. The only known compiler that doesn't support enums in bitfields is MSVC. */ @@ -238,7 +294,7 @@ { /* Integer. XINT (obj) is the integer value. */ Lisp_Int0 = 0, - Lisp_Int1 = LISP_INT1_TAG, + Lisp_Int1 = USE_LSB_TAG ? 4 : 1, /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol = 2, @@ -249,7 +305,7 @@ /* String. XSTRING (object) points to a struct Lisp_String. The length of the string, and its contents, are stored therein. */ - Lisp_String = LISP_STRING_TAG, + Lisp_String = USE_LSB_TAG ? 1 : 4, /* Vector of Lisp objects, or something resembling it. XVECTOR (object) points to a struct Lisp_Vector, which contains @@ -263,6 +319,11 @@ Lisp_Float = 7, }; +/* An older name for Lisp_Int0. */ +enum { LISP_INT_TAG = Lisp_Int0 }; + +static inline int (LISP_INT_TAG_P) (int x) { return (x & ~Lisp_Int1) == 0; } + /* This is the set of data types that share a common structure. The first member of the structure is a type code from this set. The enum values are arbitrary, but we'll use large numbers to make it @@ -297,20 +358,15 @@ typedef struct { EMACS_INT i; } Lisp_Object; -#define XLI(o) (o).i +static inline EMACS_INT (XLI) (Lisp_Object o) { return o.i; } + static inline Lisp_Object -XIL (EMACS_INT i) +(XIL) (EMACS_INT i) { Lisp_Object o = { i }; return o; } -static inline Lisp_Object -LISP_MAKE_RVALUE (Lisp_Object o) -{ - return o; -} - #define LISP_INITIALLY_ZERO {0} #else /* CHECK_LISP_OBJECT_TYPE */ @@ -318,9 +374,8 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -#define XLI(o) (o) -#define XIL(i) (i) -#define LISP_MAKE_RVALUE(o) (0+(o)) +static inline EMACS_INT (XLI) (Lisp_Object o) { return o; } +static inline Lisp_Object (XIL) (EMACS_INT i) { return i; } #define LISP_INITIALLY_ZERO 0 #endif /* CHECK_LISP_OBJECT_TYPE */ @@ -368,89 +423,119 @@ only the number of Lisp_Object fields (that need to be traced by the GC). The distinction is used e.g. by Lisp_Process which places extra non-Lisp_Object fields at the end of the structure. */ -#define PSEUDOVECTOR_SIZE_BITS 16 -#define PSEUDOVECTOR_SIZE_MASK ((1 << PSEUDOVECTOR_SIZE_BITS) - 1) -#define PVEC_TYPE_MASK (0x0fff << PSEUDOVECTOR_SIZE_BITS) +enum + { + PSEUDOVECTOR_SIZE_BITS = 16, + PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1, + PVEC_TYPE_MASK = 0xfff << PSEUDOVECTOR_SIZE_BITS + }; /* Number of bits to put in each character in the internal representation of bool vectors. This should not vary across implementations. */ -#define BOOL_VECTOR_BITS_PER_CHAR 8 -\f -/* These macros extract various sorts of values from a Lisp_Object. +enum { BOOL_VECTOR_BITS_PER_CHAR = 8 }; +\f +/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers + which were stored in a Lisp_Object */ +#ifndef DATA_SEG_BITS +# define DATA_SEG_BITS 0 +#endif +\f +/* These functions extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ /* Return a perfect hash of the Lisp_Object representation. */ -#define XHASH(a) XLI (a) - -#if USE_LSB_TAG - -#define TYPEMASK ((1 << GCTYPEBITS) - 1) -#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) -#define XINT(a) (XLI (a) >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) -#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) -#define XSET(var, type, ptr) \ - (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ - (var) = XIL ((type) | (intptr_t) (ptr))) - -#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) -#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) - -#else /* not USE_LSB_TAG */ - -#define VALMASK VAL_MAX - -#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp integers have zero-bits in their tags. */ -#define XFASTINT(a) (XLI (a) + 0) -#define XSETFASTINT(a, b) ((a) = XIL (b)) - -/* Extract the value of a Lisp_Object as a (un)signed integer. */ - -#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) -#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) - -#define XSET(var, type, ptr) \ - ((var) = XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) - -#ifdef DATA_SEG_BITS -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object */ -#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS)) -#else -#define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK)) -#endif - -#endif /* not USE_LSB_TAG */ - -/* For integers known to be positive, XFASTINT sometimes provides - faster retrieval and XSETFASTINT provides faster storage. - If not, fallback on the non-accelerated path. */ -#ifndef XFASTINT -# define XFASTINT(a) (XINT (a)) -# define XSETFASTINT(a, b) (XSETINT (a, b)) -#endif - -/* Extract the pointer value of the Lisp object A, under the - assumption that A's type is TYPE. This is a fallback - implementation if nothing faster is available. */ -#ifndef XUNTAG -# define XUNTAG(a, type) XPNTR (a) -#endif - -#define EQ(x, y) (XHASH (x) == XHASH (y)) +static inline EMACS_INT (XHASH) (Lisp_Object o) { return XLI (o); } + +#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) /* Largest and smallest representable fixnum values. These are the C values. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) +static inline enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; +} + +/* Extract the value of a Lisp_Object as a signed integer. */ +static inline EMACS_INT +(XINT) (Lisp_Object a) +{ + EMACS_INT i = XLI (a); + return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; +} + +/* Like XINT (A), but may be faster. A must be nonnegative. This takes + advantage of the fact that Lisp integers have zero-bits in their tags. */ +static inline EMACS_INT +(XFASTINT) (Lisp_Object a) +{ + EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) >> INTTYPEBITS; + eassert (0 <= n); + return n; +} + +/* Extract the value of a Lisp_Object as an unsigned integer. */ +static inline EMACS_UINT +XUINT (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; +} + +static inline Lisp_Object +(make_number) (EMACS_INT n) +{ + return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); +} + +/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +static inline Lisp_Object +make_natnum (EMACS_INT n) +{ + eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); + return USE_LSB_TAG ? make_number (n) : XIL (n); +} + +static inline void * +(XPNTR) (Lisp_Object a) +{ + intptr_t i = (XLI (a) & VALMASK) | DATA_SEG_BITS; + return (void *) i; +} + +/* Extract the pointer value of the Lisp object A, under the + assumption that A's type is TYPE. */ +static inline void * +(XUNTAG) (Lisp_Object a, int type) +{ + if (USE_LSB_TAG) + { + intptr_t i = XLI (a) - type; + return (void *) i; + } + return XPNTR (a); +} + +static inline int +(EQ) (Lisp_Object a, Lisp_Object b) +{ + return XHASH (a) == XHASH (b); +} + +/* The ubiquitous min and max macros. */ + +#ifdef max +#undef max +#undef min +#endif +#define min(a, b) ((a) < (b) ? (a) : (b)) +#define max(a, b) ((a) > (b) ? (a) : (b)) + /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned type or if I is a NaN. */ @@ -463,64 +548,181 @@ { return num < lower ? lower : num <= upper ? num : upper; } +\f +/* Forward declarations. */ + +/* Defined in this file. */ +union Lisp_Fwd; +static int BOOLFWDP (union Lisp_Fwd *); +static int BOOL_VECTOR_P (Lisp_Object); +static int BUFFER_OBJFWDP (union Lisp_Fwd *); +static int BUFFERP (Lisp_Object); +static int CHAR_TABLE_P (Lisp_Object); +static Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); +static int (CONSP) (Lisp_Object); +static int (FLOATP) (Lisp_Object); +static int (INTEGERP) (Lisp_Object); +static int INTFWDP (union Lisp_Fwd *); +static int KBOARD_OBJFWDP (union Lisp_Fwd *); +static int (MARKERP) (Lisp_Object); +static int (MISCP) (Lisp_Object); +static int (NILP) (Lisp_Object); +static int OBJFWDP (union Lisp_Fwd *); +static int OVERLAYP (Lisp_Object); +static int PROCESSP (Lisp_Object); +static int PSEUDOVECTORP (Lisp_Object, int); +static int SAVE_VALUEP (Lisp_Object); +static int STRINGP (Lisp_Object); +static int SUB_CHAR_TABLE_P (Lisp_Object); +static int SUBRP (Lisp_Object); +static int (SYMBOLP) (Lisp_Object); +static int (VECTORLIKEP) (Lisp_Object); +static int WINDOWP (Lisp_Object); + +/* Defined in buffer.c. */ +extern Lisp_Object Qoverlayp; + +/* Defined in chartab.c. */ +extern Lisp_Object char_table_ref (Lisp_Object, int); +extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object); +extern int char_table_translate (Lisp_Object, int); + +/* Defined in data.c. */ +extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; +extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; +extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qvector_or_char_table_p, Qwholenump; +extern Lisp_Object Ffboundp (Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + +/* Defined in emacs.c. */ +extern int initialized; + +/* Defined in fns.c */ +extern Lisp_Object Qhash_table_p; + +/* Defined in floatfns.c. */ +extern double extract_float (Lisp_Object); + +/* Defined in process.c. */ +extern Lisp_Object Qprocessp; + +/* Defined in window.c. */ +extern Lisp_Object Qwindowp, Qwindow_configuration_p; + +/* Defined in xdisp.c. */ +extern Lisp_Object Qimage; +\f /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) -#define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) - -/* Misc types. */ - -#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) -#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) -#define XMISCTYPE(a) (XMISCANY (a)->type) -#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) -#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) -#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC (a)->u_save_value)) - -/* Forwarding object types. */ - -#define XFWDTYPE(a) (a->u_intfwd.type) -#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) -#define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) -#define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) +static inline struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + eassert (CONSP (a)); + return XUNTAG (a, Lisp_Cons); +} + +static inline struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + +static inline struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ + eassert (SYMBOLP (a)); + return XUNTAG (a, Lisp_Symbol); +} + +static inline struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} /* Pseudovector types. */ -#define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) -#define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ - ((struct Lisp_Bool_Vector *) \ - XUNTAG (a, Lisp_Vectorlike))) +static inline struct Lisp_Process * +XPROCESS (Lisp_Object a) +{ + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct window * +XWINDOW (Lisp_Object a) +{ + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct terminal * +XTERMINAL (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct buffer * +XBUFFER (Lisp_Object a) +{ + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static inline struct Lisp_Sub_Char_Table * +XSUB_CHAR_TABLE (Lisp_Object a) +{ + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +static 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. */ +static inline Lisp_Object +xtag (enum Lisp_Type type, void *ptr) +{ + EMACS_UINT utype = type; + EMACS_INT typebits = USE_LSB_TAG ? type : utype << VALBITS; + Lisp_Object a = XIL (typebits | (intptr_t) ptr); + eassert (XUNTAG (a, type) == ptr); /* Check alignment. */ + return a; +} + +#define XSET(var, type, ptr) ((var) = xtag (type, ptr)) #define XSETINT(a, b) (a) = make_number (b) +#define XSETFASTINT(a, b) ((a) = make_natnum (b)) #define XSETCONS(a, b) XSET (a, Lisp_Cons, b) #define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b) #define XSETSTRING(a, b) XSET (a, Lisp_String, b) @@ -568,48 +770,25 @@ #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -/* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -/* The IDX==IDX tries to detect when the macro argument is side-effecting. */ -#define ASET(ARRAY, IDX, VAL) \ - (eassert ((IDX) == (IDX)), \ - eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \ - AREF ((ARRAY), (IDX)) = (VAL)) - -/* Convenience macros for dealing with Lisp strings. */ - -#define SDATA(string) (XSTRING (string)->data + 0) -#define SREF(string, index) (SDATA (string)[index] + 0) -#define SSET(string, index, new) (SDATA (string)[index] = (new)) -#define SCHARS(string) (XSTRING (string)->size + 0) -#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - -/* Avoid "differ in sign" warnings. */ -#define SSDATA(x) ((char *) SDATA (x)) - -#define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - -#define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ -#define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) - - +static inline void +(CHECK_TYPE) (int ok, Lisp_Object Qxxxp, Lisp_Object x) +{ + if (!ok) + wrong_type_argument (Qxxxp, x); +} \f /* See the macros in intervals.h. */ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type */ -#define CHECK_STRING_OR_BUFFER(x) \ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) - +static inline void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} \f /* In a cons, the markbit of the car is the gc mark bit */ @@ -650,54 +829,68 @@ #endif /* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) +static inline Lisp_Object (XCAR) (Lisp_Object c) { return XCAR_AS_LVALUE (c); } +static inline Lisp_Object (XCDR) (Lisp_Object c) { return XCDR_AS_LVALUE (c); } /* Use these to set the fields of a cons cell. Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR(c) \ - (CONSP ((c)) ? XCAR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -#define CDR(c) \ - (CONSP ((c)) ? XCDR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR_SAFE(c) \ - (CONSP ((c)) ? XCAR ((c)) : Qnil) - -#define CDR_SAFE(c) \ - (CONSP ((c)) ? XCDR ((c)) : Qnil) + should not be read after 'c' is first modified. */ +static inline void +XSETCAR (Lisp_Object c, Lisp_Object n) +{ + XCAR_AS_LVALUE (c) = n; +} +static inline void +XSETCDR (Lisp_Object c, Lisp_Object n) +{ + XCDR_AS_LVALUE (c) = n; +} + +/* Take the car or cdr of something whose type is not known. */ +static inline Lisp_Object +CAR (Lisp_Object c) +{ + return (CONSP (c) ? XCAR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} +static inline Lisp_Object +CDR (Lisp_Object c) +{ + return (CONSP (c) ? XCDR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} + +/* Take the car or cdr of something whose type is not known. */ +static inline Lisp_Object +CAR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCAR (c) : Qnil; +} +static inline Lisp_Object +CDR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCDR (c) : Qnil; +} + +/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; /* Nonzero if STR is a multibyte string. */ -#define STRING_MULTIBYTE(STR) \ - (XSTRING (STR)->size_byte >= 0) - -/* Return the length in bytes of STR. */ - -#ifdef GC_CHECK_STRING_BYTES - -struct Lisp_String; -extern ptrdiff_t string_bytes (struct Lisp_String *); -#define STRING_BYTES(S) string_bytes ((S)) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define STRING_BYTES(STR) \ - ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) - -#endif /* not GC_CHECK_STRING_BYTES */ +static inline int +STRING_MULTIBYTE (Lisp_Object str) +{ + return 0 <= XSTRING (str)->size_byte; +} /* An upper bound on the number of bytes in a Lisp string, not counting the terminating null. This a tight enough bound to @@ -727,25 +920,72 @@ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) /* Get text properties. */ -#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0) +static inline INTERVAL +STRING_INTERVALS (Lisp_Object str) +{ + return XSTRING (str)->intervals; +} /* Set text properties. */ -#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT)) - -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ - -struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; +static inline void +STRING_SET_INTERVALS (Lisp_Object str, INTERVAL intervals) +{ + XSTRING (str)->intervals = intervals; +} + +/* Convenience functions for dealing with Lisp strings. */ + +static inline unsigned char * +SDATA (Lisp_Object string) +{ + return XSTRING (string)->data; +} +static inline char * +SSDATA (Lisp_Object string) +{ + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); +} +static inline unsigned char +SREF (Lisp_Object string, ptrdiff_t index) +{ + return SDATA (string)[index]; +} +static inline void +SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) +{ + SDATA (string)[index] = new; +} +static inline ptrdiff_t +SCHARS (Lisp_Object string) +{ + return XSTRING (string)->size; +} +static inline ptrdiff_t +STRING_BYTES (struct Lisp_String *s) +{ +#ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + return string_bytes (s); +#else + return s->size_byte < 0 ? s->size : s->size_byte; +#endif +} +static inline ptrdiff_t +SBYTES (Lisp_Object string) +{ + return STRING_BYTES (XSTRING (string)); +} +static inline void +STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) +{ + XSTRING (string)->size = newsize; +} /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors other than struct Lisp_Subr. It also prevents - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ @@ -796,6 +1036,23 @@ Lisp_Object contents[1]; }; +/* Conveniences for dealing with Lisp arrays. */ + +/* A macro because it is also used as an lvalue. FIXME: Use ASET instead. */ +#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] + +static inline ptrdiff_t +ASIZE (Lisp_Object array) +{ + return XVECTOR (array)->header.size; +} + +static inline void +ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + XVECTOR (array)->contents[idx] = val; +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ #define VECSIZE(type) ((sizeof (type) \ @@ -810,53 +1067,6 @@ ((offsetof (type, nonlispfield) - offsetof (struct Lisp_Vector, contents[0])) \ / sizeof (Lisp_Object)) -/* A char-table is a kind of vectorlike, with contents are like a - vector but with a few other slots. For some purposes, it makes - sense to handle a char-table with type struct Lisp_Vector. An - element of a char table can be any Lisp objects, but if it is a sub - char-table, we treat it a table that contains information of a - specific range of characters. A sub char-table has the same - structure as a vector. A sub char table appears only in an element - of a char-table, and there's no way to access it directly from - Emacs Lisp program. */ - -/* 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. */ -#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1) - -/* Return the number of "extra" slots in the char table CT. */ - -#define CHAR_TABLE_EXTRA_SLOTS(CT) \ - (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) - -#ifdef __GNUC__ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - ({struct Lisp_Char_Table *_tbl = NULL; \ - Lisp_Object _val; \ - do { \ - _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ - _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ - : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ - if (NILP (_val)) \ - _val = _tbl->defalt; \ - } while (NILP (_val) && ! NILP (_tbl->parent)); \ - _val; }) - -#else /* not __GNUC__ */ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - (! NILP (XCHAR_TABLE (CT)->ascii) \ - ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XCHAR_TABLE (CT)->ascii \ - : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ - : char_table_ref ((CT), (IDX))) \ - : char_table_ref ((CT), (IDX))) - -#endif /* not __GNUC__ */ - /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) @@ -870,31 +1080,23 @@ /* Nonzero iff C is an ASCII character. */ #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - characters. Do not check validity of CT. */ -#define CHAR_TABLE_REF(CT, IDX) \ - (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ - : char_table_ref ((CT), (IDX))) - -/* Almost equivalent to Faref (CT, IDX). However, if the result is - not a character, return IDX. - - For these characters, do not check validity of CT - and do not follow parent. */ -#define CHAR_TABLE_TRANSLATE(CT, IDX) \ - char_table_translate (CT, IDX) - -/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit European characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \ - : char_table_set (CT, IDX, VAL)) - -#define CHARTAB_SIZE_BITS_0 6 -#define CHARTAB_SIZE_BITS_1 4 -#define CHARTAB_SIZE_BITS_2 5 -#define CHARTAB_SIZE_BITS_3 7 +/* A char-table is a kind of vectorlike, with contents are like a + vector but with a few other slots. For some purposes, it makes + sense to handle a char-table with type struct Lisp_Vector. An + element of a char table can be any Lisp objects, but if it is a sub + char-table, we treat it a table that contains information of a + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ + +enum + { + CHARTAB_SIZE_BITS_0 = 6, + CHARTAB_SIZE_BITS_1 = 4, + CHARTAB_SIZE_BITS_2 = 5, + CHARTAB_SIZE_BITS_3 = 7 + }; extern const int chartab_size[4]; @@ -951,6 +1153,70 @@ Lisp_Object contents[1]; }; +/* 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. */ +enum { CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1 }; + +/* Return the number of "extra" slots in the char table CT. */ + +static inline int +CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) +{ + return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) + - CHAR_TABLE_STANDARD_SLOTS); +} + +static inline Lisp_Object +CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) +{ + struct Lisp_Char_Table *tbl = NULL; + Lisp_Object val; + do + { + tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); + val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii + : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + if (NILP (val)) + val = tbl->defalt; + } + while (NILP (val) && ! NILP (tbl->parent)); + + return val; +} + +/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII + characters. Do not check validity of CT. */ +static inline Lisp_Object +CHAR_TABLE_REF (Lisp_Object ct, int idx) +{ + return (ASCII_CHAR_P (idx) + ? CHAR_TABLE_REF_ASCII (ct, idx) + : char_table_ref (ct, idx)); +} + +/* Almost equivalent to Faref (CT, IDX). However, if the result is + not a character, return IDX. + + For these characters, do not check validity of CT + and do not follow parent. */ +static inline int +CHAR_TABLE_TRANSLATE (Lisp_Object ct, int idx) +{ + return char_table_translate (ct, idx); +} + +/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and + 8-bit European characters. Do not check validity of CT. */ +static inline void +CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) +{ + if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) + XSUB_CHAR_TABLE (XCHAR_TABLE (ct)->ascii)->contents[idx] = val; + else + char_table_set (ct, idx, val); +} + /* A boolvector is a kind of vectorlike, with contents are like a string. */ struct Lisp_Bool_Vector { @@ -1065,41 +1331,86 @@ /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) -#define SYMBOL_ALIAS(sym) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) +static inline Lisp_Object +(SYMBOL_VAL) (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_PLAINVAL); + return sym->val.value; +} +static inline struct Lisp_Symbol * +SYMBOL_ALIAS (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + return sym->val.alias; +} +static inline struct Lisp_Buffer_Local_Value * +SYMBOL_BLV (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + return sym->val.blv; +} +static inline union Lisp_Fwd * +SYMBOL_FWD (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + return sym->val.fwd; +} +static inline void +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +{ + eassert (sym->redirect == SYMBOL_PLAINVAL); + sym->val.value = v; +} +static inline void +SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + sym->val.alias = v; +} +static inline void +SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + sym->val.blv = v; +} +static inline void +SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + sym->val.fwd = v; +} -#define SYMBOL_NAME(sym) \ - LISP_MAKE_RVALUE (XSYMBOL (sym)->xname) +static inline Lisp_Object +SYMBOL_NAME (Lisp_Object sym) +{ + return XSYMBOL (sym)->xname; +} /* Value is non-zero if SYM is an interned symbol. */ -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) +static inline int +SYMBOL_INTERNED_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; +} /* Value is non-zero if SYM is interned in initial_obarray. */ -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +static inline int +SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; +} /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +static inline int +(SYMBOL_CONSTANT_P) (Lisp_Object sym) +{ + return XSYMBOL (sym)->constant; +} #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1181,16 +1492,25 @@ }; -#define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) +static inline struct Lisp_Hash_Table * +XHASH_TABLE (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) - -#define CHECK_HASH_TABLE(x) \ - CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) +static inline int +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} +static inline void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} /* Value is the key part of entry IDX in hash table H. */ @@ -1215,12 +1535,14 @@ #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) /* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) +static inline ptrdiff_t +HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) +{ + return ASIZE (h->next); +} /* Default size for hash tables if not specified. */ - -#define DEFAULT_HASH_SIZE 65 +enum { DEFAULT_HASH_SIZE = 65 }; /* Default threshold specifying when to resize a hash table. The value gives the ratio of current entries in the hash table and the @@ -1330,6 +1652,43 @@ struct Lisp_Save_Value u_save_value; }; +static inline union Lisp_Misc * +XMISC (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Misc); +} + +static inline struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return & XMISC (a)->u_any; +} + +/* A macro because it is also used as an lvalue. FIXME: clean this up. */ +#define XMISCTYPE(a) (XMISCANY (a)->type) + +static inline struct Lisp_Marker * +XMARKER (Lisp_Object a) +{ + eassert (MARKERP (a)); + return & XMISC (a)->u_marker; +} + +static inline struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) +{ + eassert (OVERLAYP (a)); + return & XMISC (a)->u_overlay; +} + +static inline struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} +\f /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1419,13 +1778,29 @@ Lisp_Object valcell; }; -#define BLV_FOUND(blv) \ - (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found) -#define SET_BLV_FOUND(blv, v) \ - (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v)) +static inline int +BLV_FOUND (struct Lisp_Buffer_Local_Value *blv) +{ + eassert (blv->found == !EQ (blv->defcell, blv->valcell)); + return blv->found; +} +static inline void +SET_BLV_FOUND (struct Lisp_Buffer_Local_Value *blv, int v) +{ + eassert (v == !EQ (blv->defcell, blv->valcell)); + blv->found = v; +} -#define BLV_VALUE(blv) (XCDR ((blv)->valcell)) -#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v)) +static inline Lisp_Object +BLV_VALUE (struct Lisp_Buffer_Local_Value *blv) +{ + return XCDR (blv->valcell); +} +static inline void +SET_BLV_VALUE (struct Lisp_Buffer_Local_Value *blv, Lisp_Object v) +{ + XSETCDR (blv->valcell, v); +} /* Like Lisp_Objfwd except that value lives in a slot in the current kboard. */ @@ -1443,6 +1818,47 @@ struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; + +static inline enum Lisp_Fwd_Type +XFWDTYPE (union Lisp_Fwd *a) +{ + return a->u_intfwd.type; +} + +static inline struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} + +static inline struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} + +static inline struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +static inline struct Lisp_Buffer_Objfwd * +XBUFFER_OBJFWD (union Lisp_Fwd *a) +{ + eassert (BUFFER_OBJFWDP (a)); + return &a->u_buffer_objfwd; +} + +static inline struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} \f /* Lisp floating point type. */ struct Lisp_Float @@ -1458,13 +1874,24 @@ } u; }; +static inline double +XFLOAT_DATA (Lisp_Object f) +{ #ifdef HIDE_LISP_IMPLEMENTATION -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data_ : XFLOAT (f)->u.data_) + return XFLOAT (f)->u.data_; #else -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) + return XFLOAT (f)->u.data; +#endif +} + +#ifndef HIDE_LISP_IMPLEMENTATION /* This should be used only in alloc.c, which always disables HIDE_LISP_IMPLEMENTATION. */ -#define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n)) +static inline void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} #endif /* A character, declared with the following typedef, is a member @@ -1475,91 +1902,36 @@ #endif /* Meanings of slots in a Lisp_Compiled: */ - -#define COMPILED_ARGLIST 0 -#define COMPILED_BYTECODE 1 -#define COMPILED_CONSTANTS 2 -#define COMPILED_STACK_DEPTH 3 -#define COMPILED_DOC_STRING 4 -#define COMPILED_INTERACTIVE 5 +enum + { + COMPILED_ARGLIST, + COMPILED_BYTECODE, + COMPILED_CONSTANTS, + COMPILED_STACK_DEPTH, + COMPILED_DOC_STRING, + COMPILED_INTERACTIVE + }; /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE (MUlti-Lingual Emacs) might need 22 bits for the character value itself, so we probably shouldn't use any bits lower than 0x0400000. */ -#define CHAR_ALT (0x0400000) -#define CHAR_SUPER (0x0800000) -#define CHAR_HYPER (0x1000000) -#define CHAR_SHIFT (0x2000000) -#define CHAR_CTL (0x4000000) -#define CHAR_META (0x8000000) - -#define CHAR_MODIFIER_MASK \ - (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META) - +enum + { + CHAR_ALT = 0x0400000, + CHAR_SUPER = 0x0800000, + CHAR_HYPER = 0x1000000, + CHAR_SHIFT = 0x2000000, + CHAR_CTL = 0x4000000, + CHAR_META = 0x8000000, + CHAR_MODIFIER_MASK = + CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META + }; /* Actually, the current Emacs uses 22 bits for the character value itself. */ -#define CHARACTERBITS 22 - -\f -/* The glyph datatype, used to represent characters on the display. - It consists of a char code and a face id. */ - -typedef struct { - int ch; - int face_id; -} GLYPH; - -/* Return a glyph's character code. */ -#define GLYPH_CHAR(glyph) ((glyph).ch) - -/* Return a glyph's face ID. */ -#define GLYPH_FACE(glyph) ((glyph).face_id) - -#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) -#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) -#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) - -/* Return 1 if GLYPH contains valid character code. */ -#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) - - -/* Glyph Code from a display vector may either be an integer which - encodes a char code in the lower CHARACTERBITS bits and a (very small) - face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ - -#define GLYPH_CODE_P(gc) \ - (CONSP (gc) \ - ? (CHARACTERP (XCAR (gc)) \ - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ - : (RANGED_INTEGERP \ - (0, gc, \ - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ - ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ - : TYPE_MAXIMUM (EMACS_INT))))) - -/* The following are valid only if GLYPH_CODE_P (gc). */ - -#define GLYPH_CODE_CHAR(gc) \ - (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) - -#define GLYPH_CODE_FACE(gc) \ - (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) - -#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ - do \ - { \ - if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ - else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ - } \ - while (0) - -/* The ID of the mode line highlighting face. */ -#define GLYPH_MODE_LINE_FACE 1 +enum { CHARACTERBITS = 22 }; + \f /* Structure to hold mouse highlight data. This is here because other header files need it for defining struct x_output etc. */ @@ -1598,140 +1970,308 @@ \f /* Data type checking */ -#define NILP(x) EQ (x, Qnil) - -#define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) - -#define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) +static inline int +(NILP) (Lisp_Object x) +{ + return EQ (x, Qnil); +} + +static inline int +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x); +} +static inline int +NATNUMP (Lisp_Object x) +{ + return INTEGERP (x) && 0 <= XINT (x); +} + +static inline int +RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +{ + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; +} + #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - -#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) -#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - -#define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) -#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) - -#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) -#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) -#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) -#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) -#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - -/* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ -#define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) - -#define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS))) - -/* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ -#define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + +static inline int (CONSP) (Lisp_Object x) { return XTYPE (x) == Lisp_Cons; } +static inline int (FLOATP) (Lisp_Object x) { return XTYPE (x) == Lisp_Float; } +static inline int (MISCP) (Lisp_Object x) { return XTYPE (x) == Lisp_Misc; } +static inline int STRINGP (Lisp_Object x) { return XTYPE (x) == Lisp_String; } +static inline int +(SYMBOLP) (Lisp_Object x) +{ + return XTYPE (x) == Lisp_Symbol; +} +static inline int +(INTEGERP) (Lisp_Object x) +{ + return LISP_INT_TAG_P (XTYPE (x)); +} +static inline int +(VECTORLIKEP) (Lisp_Object x) +{ + return XTYPE (x) == Lisp_Vectorlike; +} +static inline int +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} +static inline int +OVERLAYP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; +} +static inline int +(MARKERP) (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker; +} +static inline int +SAVE_VALUEP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; +} + +static inline int +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +static inline int +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +static inline int +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} +static inline int +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} +static inline int +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} + +/* True if the size field SIZE of a pseudovector is that of a + pseudovector whose code is CODE. */ +static inline int +PSEUDOVECTOR_SIZE_TYPEP (ptrdiff_t size, int code) +{ + return ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +static inline int +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_SIZE_TYPEP (h->size, code); + } +} + /* Test for specific pseudovector types. */ -#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) + +static inline int +WINDOW_CONFIGURATIONP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); +} + +static inline int +PROCESSP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_PROCESS); +} + +static inline int +WINDOWP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW); +} + +static inline int +TERMINALP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TERMINAL); +} + /* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */ -#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) -#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) +static inline int +SUBRP (Lisp_Object a) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + struct Lisp_Subr *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_SIZE_TYPEP (h->size, PVEC_SUBR); + } +} + +static inline int +COMPILEDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_COMPILED); +} + +static inline int +BUFFERP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BUFFER); +} + +static inline int +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +static inline int +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); +} + +static inline int +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +static inline int +FRAMEP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_FRAME); +} /* Test for image (image . spec) */ -#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +static inline int +IMAGEP (Lisp_Object x) +{ + return CONSP (x) && EQ (XCAR (x), Qimage); +} /* Array types. */ - -#define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) +static inline int +ARRAYP (Lisp_Object x) +{ + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); +} \f -#define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - -#define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - -#define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - -#define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - -#define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - -#define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - -#define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - -#define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - -#define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - -#define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - -#define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - -#define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - -#define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - -#define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - -/* This macro rejects windows on the interior of the window tree as - "dead", which is what we want; this is an argument-checking macro, and - the user should never get access to interior windows. - - A window of any sort, leaf or interior, is dead if the buffer, - vchild, and hchild members are all nil. */ - -#define CHECK_LIVE_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x) - -#define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - -#define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) - -#define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) - -#define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) +static inline void +CHECK_LIST (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); +} +static inline void +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (CONSP (x), Qlistp, y); +} +static inline void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} +static inline void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} +static inline void +CHECK_STRING_CAR (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); +} +static inline void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} +static inline void +(CHECK_SYMBOL) (Lisp_Object x) +{ + CHECK_TYPE (SYMBOLP (x), Qsymbolp, x); +} +static inline void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} +static inline void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} +static inline void +CHECK_VECTOR_OR_STRING (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); +} +static inline void +CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +{ + CHECK_TYPE (ARRAYP (x), Qxxxp, x); +} +static inline void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} +static inline void +CHECK_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (BUFFERP (x), Qbufferp, x); +} +static inline void +CHECK_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x), Qwindowp, x); +} +static inline void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} +static inline void +CHECK_PROCESS (Lisp_Object x) +{ + CHECK_TYPE (PROCESSP (x), Qprocessp, x); +} +static inline void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} +static inline void +(CHECK_NUMBER) (Lisp_Object x) +{ + CHECK_TYPE (INTEGERP (x), Qintegerp, x); +} +static inline void +CHECK_NATNUM (Lisp_Object x) +{ + CHECK_TYPE (NATNUMP (x), Qwholenump, x); +} #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@ -1752,57 +2292,76 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -#define CHECK_MARKER(x) \ - CHECK_TYPE (MARKERP (x), Qmarkerp, x) +static inline void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) -#define XFLOATINT(n) extract_float((n)) - -#define CHECK_FLOAT(x) \ - CHECK_TYPE (FLOATP (x), Qfloatp, x) - -#define CHECK_NUMBER_OR_FLOAT(x) \ - CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) +static inline double +XFLOATINT (Lisp_Object n) +{ + return extract_float (n); +} + +static inline void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} +static inline void +CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); +} #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -#define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) +static inline void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ -#define CHECK_NUMBER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) +static inline void +CHECK_NUMBER_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); +} + +static inline void +CHECK_NUMBER_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); +} + +static inline void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +static inline void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} \f /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -1869,18 +2428,20 @@ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) /* Non-zero if OBJ is a Lisp function. */ -#define FUNCTIONP(OBJ) \ - ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ - || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ - || COMPILEDP (OBJ) \ - || SUBRP (OBJ)) +static inline int +FUNCTIONP (Lisp_Object obj) +{ + return ((CONSP (obj) && EQ (XCAR (obj), Qlambda)) + || (SYMBOLP (obj) && !NILP (Ffboundp (obj))) + || COMPILEDP (obj) + || SUBRP (obj)); +} /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ extern void defsubr (struct Lisp_Subr *); -#define MANY -2 -#define UNEVALLED -1 +enum { MANY = -2, UNEVALLED = -1 }; extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *); extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *); @@ -1973,7 +2534,11 @@ extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +static inline ptrdiff_t +SPECPDL_INDEX (void) +{ + return specpdl_ptr - specpdl; +} /* Everything needed to describe an active condition case. */ struct handler @@ -2283,6 +2848,8 @@ #define EXFUN(fnname, maxargs) \ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs +#include "globals.h" + /* Forward declarations for prototypes. */ struct window; struct frame; @@ -2317,6 +2884,7 @@ extern Lisp_Object Qinteger, Qinterval, Qsymbol, Qstring; extern Lisp_Object Qmisc, Qvector, Qfloat, Qcons, Qbuffer; +extern Lisp_Object Qsubrp; extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; @@ -2411,6 +2979,7 @@ extern Lisp_Object Qcursor_in_echo_area; extern Lisp_Object Qstring_lessp; extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql; +extern Lisp_Object Qhash_table_p; EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object, @@ -2706,7 +3275,7 @@ Lisp_Object); extern Lisp_Object internal_with_output_to_temp_buffer (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object); -#define FLOAT_TO_STRING_BUFSIZE 350 +enum { FLOAT_TO_STRING_BUFSIZE = 350 }; extern int float_to_string (char *, double); extern void syms_of_print (void); @@ -2729,10 +3298,12 @@ extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); -#define LOADHIST_ATTACH(x) \ - do { \ - if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ - } while (0) +static inline void +LOADHIST_ATTACH (Lisp_Object x) +{ + if (initialized) + Vcurrent_load_list = Fcons (x, Vcurrent_load_list); +} extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object); Lisp_Object string_to_number (char const *, int, int); @@ -2850,6 +3421,7 @@ extern Lisp_Object Vbuffer_alist; extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); +extern Lisp_Object Qoverlayp; extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); extern void init_buffer_once (void); @@ -3007,10 +3579,10 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -#define setlocale(category, locale) -#define fixup_locale() -#define synchronize_system_messages_locale() -#define synchronize_system_time_locale() +static inline char *setlocale (int cat, char const *locale) { return 0; } +static inline void fixup_locale (void) {} +static inline void synchronize_system_messages_locale (void) {} +static inline void synchronize_system_time_locale (void) {} #endif void shut_down_emacs (int, int, Lisp_Object); /* Nonzero means don't do interactive redisplay and don't change tty modes. */ @@ -3271,19 +3843,19 @@ in addition to a device separator. Set the path separator to '/', and don't test for a device separator in IS_ANY_SEP. */ -#define DIRECTORY_SEP '/' +enum { DIRECTORY_SEP = '/' }; #ifndef IS_DIRECTORY_SEP -#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) +static inline int IS_DIRECTORY_SEP (int c) { return c == DIRECTORY_SEP; } #endif #ifndef IS_DEVICE_SEP #ifndef DEVICE_SEP -#define IS_DEVICE_SEP(_c_) 0 +static inline int IS_DEVICE_SEP (int c) { return 0; } #else -#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP) +static inline int IS_DEVICE_SEP (int c) { return c == DEVICE_SEP; } #endif #endif #ifndef IS_ANY_SEP -#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_)) +static inline int IS_ANY_SEP (int c) { return IS_DIRECTORY_SEP (c); } #endif #define SWITCH_ENUM_CAST(x) (x) @@ -3303,15 +3875,6 @@ # define lint_assume(cond) ((void) (0 && (cond))) #endif -/* The ubiquitous min and max macros. */ - -#ifdef max -#undef max -#undef min -#endif -#define min(a, b) ((a) < (b) ? (a) : (b)) -#define max(a, b) ((a) > (b) ? (a) : (b)) - /* We used to use `abs', but that clashes with system headers on some platforms, and using a name reserved by Standard C is a bad idea anyway. */ @@ -3354,7 +3917,7 @@ /* SAFE_ALLOCA normally allocates memory on the stack, but if size is larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */ -#define MAX_ALLOCA 16*1024 +enum { MAX_ALLOCA = 16*1024 }; extern Lisp_Object safe_alloca_unwind (Lisp_Object); @@ -3424,8 +3987,6 @@ } while (0) -#include "globals.h" - /* Check whether it's time for GC, and run it if so. */ static inline void === modified file 'src/mem-limits.h' --- src/mem-limits.h 2012-07-09 16:38:45 +0000 +++ src/mem-limits.h 2012-07-13 03:37:42 +0000 @@ -36,9 +36,7 @@ extern char *start_of_data (void) ATTRIBUTE_CONST; #if USE_LSB_TAG || UINTPTR_MAX <= VAL_MAX #define EXCEEDS_LISP_PTR(ptr) 0 -#elif defined DATA_SEG_BITS +#else #define EXCEEDS_LISP_PTR(ptr) \ (((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS) -#else -#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS) #endif === modified file 'src/window.c' --- src/window.c 2012-07-23 16:57:20 +0000 +++ src/window.c 2012-07-23 21:50:36 +0000 @@ -51,8 +51,8 @@ #include "nsterm.h" #endif -Lisp_Object Qwindowp, Qwindow_live_p; -static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; +Lisp_Object Qwindowp, Qwindow_live_p, Qwindow_configuration_p; +static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; === modified file 'src/window.h' --- src/window.h 2012-07-05 15:20:12 +0000 +++ src/window.h 2012-07-13 03:37:42 +0000 @@ -885,7 +885,7 @@ /* These used to be in lisp.h. */ -extern Lisp_Object Qwindowp, Qwindow_live_p; +extern Lisp_Object Qwindow_live_p; extern Lisp_Object Vwindow_list; extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); @@ -900,4 +900,17 @@ extern void syms_of_window (void); extern void keys_of_window (void); +/* CHECK_LIVE_WINDOW rejects windows on the interior of the window tree as + "dead", which is what we want; this is an argument-checking function, and + the user should never get access to interior windows. + + A window of any sort, leaf or interior, is dead if the buffer, + vchild, and hchild members are all nil. */ +static inline void +CHECK_LIVE_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x); +} + + #endif /* not WINDOW_H_INCLUDED */ ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-24 2:20 ` Paul Eggert @ 2012-07-24 9:07 ` Stefan Monnier 2012-07-24 13:45 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2012-07-24 9:07 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 > results. So instead of using always_inline, it's better to > do this performance-critical inlining by hand. I did that Could you separate this part of the patch, since I don't know what you mean by "inlining by hand". Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-24 9:07 ` Stefan Monnier @ 2012-07-24 13:45 ` Paul Eggert 2012-07-24 21:57 ` Stefan Monnier 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2012-07-24 13:45 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 [-- Attachment #1: Type: text/plain, Size: 285 bytes --] On 07/24/2012 02:07 AM, Stefan Monnier wrote: > Could you separate this part of the patch, since I don't know what you > mean by "inlining by hand". Sure, attached; this assumes the earlier patch in <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11935#5> has been applied and merged. [-- Attachment #2: inline-by-hand.txt --] [-- Type: text/plain, Size: 11390 bytes --] 2012-07-24 Paul Eggert <eggert@cs.ucla.edu> * lisp.h (XLI, XIL, CHECK_TYPE, CHECK_LIST_CONS, CHECK_NUMBER) (CHECK_SYMBOL, CONSP, EQ, FLOATP, INTEGERP, LISP_INT_TAG_P, MARKERP) (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): If compiling via GCC without optimization, inline these functions manually, by defining macros in addition to inline functions. To disable this, compile with -DINLINING=0. (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. === modified file 'src/lisp.h' --- src/lisp.h 2012-07-23 21:58:10 +0000 +++ src/lisp.h 2012-07-24 01:57:18 +0000 @@ -214,6 +214,62 @@ #endif +/* When compiling via GCC without optimization, inline a few functions + manually, as Emacs is too slow otherwise. There's no need to + inline everything, just the functions that would cause a serious + performance problem when debugging. To disable this hand-optimization, + compile with -DINLINING=0. + + Commentary for these macros can be found near their corresponding + functions, below. */ +#if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ + && ! (defined INLINING && ! INLINING)) +# if CHECK_LISP_OBJECT_TYPE +# define XLI(o) (o).i +# define XIL(i) (Lisp_Object) { i } +# else +# define XLI(o) (o) +# define XIL(i) (i) +# endif +# define CHECK_TYPE(ok, Qxxxp, x) \ + ((void) ((ok) || wrong_type_argument (Qxxxp, x))) +# define CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) +# define CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) +# define CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) +# define CONSP(x) (XTYPE (x) == Lisp_Cons) +# define EQ(a, b) (XHASH (a) == XHASH (b)) +# define FLOATP(x) (XTYPE (x) == Lisp_Float) +# define INTEGERP(x) LISP_INT_TAG_P (XTYPE (x)) +# define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) +# define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) +# define MISCP(x) (XTYPE (x) == Lisp_Misc) +# define NILP(x) EQ (x, Qnil) +# define SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +# define SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +# define SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) +# define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) +# define VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +# define XCAR(c) XCAR_AS_LVALUE (c) +# define XCDR(c) XCDR_AS_LVALUE (c) +# define XCONS(a) \ + (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +# define XHASH(o) XLI (o) +# define XPNTR(a) ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) +# define XSYMBOL(a) \ + (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +# if USE_LSB_TAG +# define make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS) +# define XFASTINT(a) XINT (a) +# define XINT(a) (XLI (a) >> INTTYPEBITS) +# define XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) +# define XUNTAG(a, type) ((void *) (XLI (a) - (type))) +# endif +#endif + + /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. */ @@ -266,7 +322,7 @@ /* An older name for Lisp_Int0. */ enum { LISP_INT_TAG = Lisp_Int0 }; -static inline int LISP_INT_TAG_P (int x) { return (x & ~Lisp_Int1) == 0; } +static inline int (LISP_INT_TAG_P) (int x) { return (x & ~Lisp_Int1) == 0; } /* This is the set of data types that share a common structure. The first member of the structure is a type code from this set. @@ -302,10 +358,10 @@ typedef struct { EMACS_INT i; } Lisp_Object; -static inline EMACS_INT XLI (Lisp_Object o) { return o.i; } +static inline EMACS_INT (XLI) (Lisp_Object o) { return o.i; } static inline Lisp_Object -XIL (EMACS_INT i) +(XIL) (EMACS_INT i) { Lisp_Object o = { i }; return o; @@ -318,8 +374,8 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -static inline EMACS_INT XLI (Lisp_Object o) { return o; } -static inline Lisp_Object XIL (EMACS_INT i) { return i; } +static inline EMACS_INT (XLI) (Lisp_Object o) { return o; } +static inline Lisp_Object (XIL) (EMACS_INT i) { return i; } #define LISP_INITIALLY_ZERO 0 #endif /* CHECK_LISP_OBJECT_TYPE */ @@ -389,7 +445,7 @@ XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ /* Return a perfect hash of the Lisp_Object representation. */ -static inline EMACS_INT XHASH (Lisp_Object o) { return XLI (o); } +static inline EMACS_INT (XHASH) (Lisp_Object o) { return XLI (o); } #define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) @@ -399,7 +455,7 @@ #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) static inline enum Lisp_Type -XTYPE (Lisp_Object a) +(XTYPE) (Lisp_Object a) { EMACS_UINT i = XLI (a); return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; @@ -407,7 +463,7 @@ /* Extract the value of a Lisp_Object as a signed integer. */ static inline EMACS_INT -XINT (Lisp_Object a) +(XINT) (Lisp_Object a) { EMACS_INT i = XLI (a); return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; @@ -416,7 +472,7 @@ /* Like XINT (A), but may be faster. A must be nonnegative. This takes advantage of the fact that Lisp integers have zero-bits in their tags. */ static inline EMACS_INT -XFASTINT (Lisp_Object a) +(XFASTINT) (Lisp_Object a) { EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) >> INTTYPEBITS; eassert (0 <= n); @@ -432,7 +488,7 @@ } static inline Lisp_Object -make_number (EMACS_INT n) +(make_number) (EMACS_INT n) { return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); } @@ -446,7 +502,7 @@ } static inline void * -XPNTR (Lisp_Object a) +(XPNTR) (Lisp_Object a) { intptr_t i = (XLI (a) & VALMASK) | DATA_SEG_BITS; return (void *) i; @@ -455,7 +511,7 @@ /* Extract the pointer value of the Lisp object A, under the assumption that A's type is TYPE. */ static inline void * -XUNTAG (Lisp_Object a, int type) +(XUNTAG) (Lisp_Object a, int type) { if (USE_LSB_TAG) { @@ -466,7 +522,7 @@ } static inline int -EQ (Lisp_Object a, Lisp_Object b) +(EQ) (Lisp_Object a, Lisp_Object b) { return XHASH (a) == XHASH (b); } @@ -503,14 +559,14 @@ static int BUFFERP (Lisp_Object); static int CHAR_TABLE_P (Lisp_Object); static Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); -static int CONSP (Lisp_Object); -static int FLOATP (Lisp_Object); -static int INTEGERP (Lisp_Object); +static int (CONSP) (Lisp_Object); +static int (FLOATP) (Lisp_Object); +static int (INTEGERP) (Lisp_Object); static int INTFWDP (union Lisp_Fwd *); static int KBOARD_OBJFWDP (union Lisp_Fwd *); -static int MARKERP (Lisp_Object); -static int MISCP (Lisp_Object); -static int NILP (Lisp_Object); +static int (MARKERP) (Lisp_Object); +static int (MISCP) (Lisp_Object); +static int (NILP) (Lisp_Object); static int OBJFWDP (union Lisp_Fwd *); static int OVERLAYP (Lisp_Object); static int PROCESSP (Lisp_Object); @@ -519,8 +575,8 @@ static int STRINGP (Lisp_Object); static int SUB_CHAR_TABLE_P (Lisp_Object); static int SUBRP (Lisp_Object); -static int SYMBOLP (Lisp_Object); -static int VECTORLIKEP (Lisp_Object); +static int (SYMBOLP) (Lisp_Object); +static int (VECTORLIKEP) (Lisp_Object); static int WINDOWP (Lisp_Object); /* Defined in buffer.c. */ @@ -561,7 +617,7 @@ /* Extract a value or address from a Lisp_Object. */ static inline struct Lisp_Cons * -XCONS (Lisp_Object a) +(XCONS) (Lisp_Object a) { eassert (CONSP (a)); return XUNTAG (a, Lisp_Cons); @@ -582,7 +638,7 @@ } static inline struct Lisp_Symbol * -XSYMBOL (Lisp_Object a) +(XSYMBOL) (Lisp_Object a) { eassert (SYMBOLP (a)); return XUNTAG (a, Lisp_Symbol); @@ -717,7 +773,7 @@ /* Type checking. */ static inline void -CHECK_TYPE (int ok, Lisp_Object Qxxxp, Lisp_Object x) +(CHECK_TYPE) (int ok, Lisp_Object Qxxxp, Lisp_Object x) { if (!ok) wrong_type_argument (Qxxxp, x); @@ -773,8 +829,8 @@ #endif /* Use these from normal code. */ -static inline Lisp_Object XCAR (Lisp_Object c) { return XCAR_AS_LVALUE (c); } -static inline Lisp_Object XCDR (Lisp_Object c) { return XCDR_AS_LVALUE (c); } +static inline Lisp_Object (XCAR) (Lisp_Object c) { return XCAR_AS_LVALUE (c); } +static inline Lisp_Object (XCDR) (Lisp_Object c) { return XCDR_AS_LVALUE (c); } /* Use these to set the fields of a cons cell. @@ -1276,7 +1332,7 @@ /* Value is name of symbol. */ static inline Lisp_Object -SYMBOL_VAL (struct Lisp_Symbol *sym) +(SYMBOL_VAL) (struct Lisp_Symbol *sym) { eassert (sym->redirect == SYMBOL_PLAINVAL); return sym->val.value; @@ -1300,7 +1356,7 @@ return sym->val.fwd; } static inline void -SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v) +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) { eassert (sym->redirect == SYMBOL_PLAINVAL); sym->val.value = v; @@ -1351,7 +1407,7 @@ whose value can be set to the keyword symbol itself). */ static inline int -SYMBOL_CONSTANT_P (Lisp_Object sym) +(SYMBOL_CONSTANT_P) (Lisp_Object sym) { return XSYMBOL (sym)->constant; } @@ -1915,7 +1971,7 @@ /* Data type checking */ static inline int -NILP (Lisp_Object x) +(NILP) (Lisp_Object x) { return EQ (x, Qnil); } @@ -1942,18 +1998,22 @@ && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ && XINT (x) <= TYPE_MAXIMUM (type)) -static inline int CONSP (Lisp_Object x) { return XTYPE (x) == Lisp_Cons; } -static inline int FLOATP (Lisp_Object x) { return XTYPE (x) == Lisp_Float; } -static inline int MISCP (Lisp_Object x) { return XTYPE (x) == Lisp_Misc; } +static inline int (CONSP) (Lisp_Object x) { return XTYPE (x) == Lisp_Cons; } +static inline int (FLOATP) (Lisp_Object x) { return XTYPE (x) == Lisp_Float; } +static inline int (MISCP) (Lisp_Object x) { return XTYPE (x) == Lisp_Misc; } static inline int STRINGP (Lisp_Object x) { return XTYPE (x) == Lisp_String; } -static inline int SYMBOLP (Lisp_Object x) { return XTYPE (x) == Lisp_Symbol; } -static inline int -INTEGERP (Lisp_Object x) +static inline int +(SYMBOLP) (Lisp_Object x) +{ + return XTYPE (x) == Lisp_Symbol; +} +static inline int +(INTEGERP) (Lisp_Object x) { return LISP_INT_TAG_P (XTYPE (x)); } static inline int -VECTORLIKEP (Lisp_Object x) +(VECTORLIKEP) (Lisp_Object x) { return XTYPE (x) == Lisp_Vectorlike; } @@ -1968,7 +2028,7 @@ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; } static inline int -MARKERP (Lisp_Object x) +(MARKERP) (Lisp_Object x) { return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker; } @@ -2123,7 +2183,7 @@ CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); } static inline void -CHECK_LIST_CONS (Lisp_Object x, Lisp_Object y) +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) { CHECK_TYPE (CONSP (x), Qlistp, y); } @@ -2148,7 +2208,7 @@ CHECK_TYPE (CONSP (x), Qconsp, x); } static inline void -CHECK_SYMBOL (Lisp_Object x) +(CHECK_SYMBOL) (Lisp_Object x) { CHECK_TYPE (SYMBOLP (x), Qsymbolp, x); } @@ -2203,7 +2263,7 @@ CHECK_TYPE (SUBRP (x), Qsubrp, x); } static inline void -CHECK_NUMBER (Lisp_Object x) +(CHECK_NUMBER) (Lisp_Object x) { CHECK_TYPE (INTEGERP (x), Qintegerp, x); } ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-24 13:45 ` Paul Eggert @ 2012-07-24 21:57 ` Stefan Monnier 2012-07-25 4:07 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2012-07-24 21:57 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 > Sure, attached; this assumes the earlier patch in > <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11935#5> > has been applied and merged. I'm not sure I understand what it does. It seems to define XLI first as a macro then as a function. Is that right? If so, why is it any better than using only the macro form? Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-24 21:57 ` Stefan Monnier @ 2012-07-25 4:07 ` Paul Eggert 0 siblings, 0 replies; 41+ messages in thread From: Paul Eggert @ 2012-07-25 4:07 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 On 07/24/2012 02:57 PM, Stefan Monnier wrote: > It seems to define XLI first as > a macro then as a function. Is that right? Yes. The macro is purely for performance with -O0. The function is for all other purposes, including having XLI work in expressions given to GDB. > why is it any better than using only the macro form? Mostly for debuggability, though there's also a small performance win when compiling with default (-O2) optimization. Having the functions makes GDB more useful when printing expressions. Here's a trivial example: (gdb) p SYMBOLP (Qnil) $3 = 1 With the patch, this works if one compiles with -g -O0, regardless of whether -DINLINING=0 is also specified. This is because SYMBOLP is defined as a function, regardless of whether it is also defined as a macro. Also, having the functions makes backtraces work better, even when compiling with default optimization. For example, here's the start of a GDB backtrace of a patched Emacs compiled with default optimization: (gdb) where #0 XTYPE (a=0) at lisp.h:461 #1 VECTORLIKEP (x=0) at lisp.h:2018 #2 PSEUDOVECTORP (code=2, a=0) at lisp.h:2080 #3 PROCESSP (a=0) at lisp.h:2102 #4 Fget_process (name=0) at process.c:680 #5 0x0000000000573e87 in eval_sub (form=form@entry=16514534) at eval.c:2146 ... When the macro forms are used, levels #0 through #3 are lost, which makes things harder to follow, particularly when one is not expert in the code. This debuggability win is partly lost when compiling with plain -O0, because then some functions turn into macros. But that's OK, since one can compile with -O0 -DINLINING=0 to get nicer debugging. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-13 15:07 bug#11935: XINT etc. should be functions Paul Eggert 2012-07-14 2:20 ` bug#11935: [TRUNCATED MESSAGE 2746 87596] " Richard Stallman @ 2012-07-15 14:41 ` Chong Yidong 2012-07-15 16:40 ` Paul Eggert 2013-06-06 15:56 ` Paul Eggert 2013-06-10 13:40 ` Barry OReilly 3 siblings, 1 reply; 41+ messages in thread From: Chong Yidong @ 2012-07-15 14:41 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 Paul Eggert <eggert@cs.ucla.edu> writes: > Here's a patch I plan to install after some more testing. It changes > lisp.h to prefer functions to function-like macros, and constants to > object-like macros, when either will do. I think this is too fundamental a change for 24.2. Please don't install. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-15 14:41 ` Chong Yidong @ 2012-07-15 16:40 ` Paul Eggert 2012-07-16 2:22 ` Chong Yidong 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2012-07-15 16:40 UTC (permalink / raw) To: Chong Yidong; +Cc: 11935 On 07/15/2012 07:41 AM, Chong Yidong wrote: > I think this is too fundamental a change for 24.2. I wasn't planning to install it into the emacs-24 branch; only the trunk. Is 24.2 going to come from the emacs-24 branch? If so, what would be the problem with making this change to the trunk? And if not, then where should post-24 changes go? ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-15 16:40 ` Paul Eggert @ 2012-07-16 2:22 ` Chong Yidong 2012-07-16 14:54 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Chong Yidong @ 2012-07-16 2:22 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 Paul Eggert <eggert@cs.ucla.edu> writes: > I wasn't planning to install it into the emacs-24 branch; only the > trunk. Is 24.2 going to come from the emacs-24 branch? No, from the trunk. I've explained this several times on emacs-devel, but maybe you missed those messages. The emacs-24 branch is only in case of emergency (e.g. security) release. Otherwise, 24.2 will be from the trunk; it will include new features, i.e. it won't be a bugfix-only release. But this change could be rather disruptive, for apparently negligible gain, so better leave it out, I think. > And if not, then where should post-24 changes go? You can make a new branch, if you like, or just keep this as a bug in the BTS. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-16 2:22 ` Chong Yidong @ 2012-07-16 14:54 ` Paul Eggert 0 siblings, 0 replies; 41+ messages in thread From: Paul Eggert @ 2012-07-16 14:54 UTC (permalink / raw) To: Chong Yidong; +Cc: 11935 On 07/15/2012 07:22 PM, Chong Yidong wrote: > You can make a new branch, if you like, or just keep this as a bug in > the BTS. Thanks, I think I'll just keep it as a bug then. And thanks for patiently explaining the plan one more time -- I had read the earlier messages but clearly they did not sink in. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-13 15:07 bug#11935: XINT etc. should be functions Paul Eggert 2012-07-14 2:20 ` bug#11935: [TRUNCATED MESSAGE 2746 87596] " Richard Stallman 2012-07-15 14:41 ` Chong Yidong @ 2013-06-06 15:56 ` Paul Eggert 2013-06-06 16:36 ` Andreas Schwab 2013-06-06 16:42 ` Stefan Monnier 2013-06-10 13:40 ` Barry OReilly 3 siblings, 2 replies; 41+ messages in thread From: Paul Eggert @ 2013-06-06 15:56 UTC (permalink / raw) To: 11935 [-- Attachment #1: Type: text/plain, Size: 286 bytes --] Attached is an updated version of this patch, relative to the current trunk (bzr 112869). Since the last version of the patch we've added several inline functions to lisp.h, such as specpdl_symbol, make_lisp_proc, SAVE_VALUEP, and I've merged them all in. I'd like to apply this soon. [-- Attachment #2: inline4.txt --] [-- Type: text/plain, Size: 76265 bytes --] === modified file 'ChangeLog' --- ChangeLog 2013-06-03 19:38:06 +0000 +++ ChangeLog 2013-06-06 15:40:14 +0000 @@ -1,3 +1,9 @@ +2013-06-06 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + 2013-06-03 Michael Albinus <michael.albinus@gmx.de> * configure.ac (HAVE_GFILENOTIFY): Check for gio >= 2.24. @@ -183,7 +189,7 @@ `-Wl,-bpe-i386', which is confusing in the 64-bit case. (Bug#12993) -2013-04-07 Paul Eggert <eggert@cs.ucla.edu> +2013-04-06 Paul Eggert <eggert@cs.ucla.edu> Fix --enable-profiling bug introduced by 2013-02-25 change (Bug#13783). * configure.ac (LD_SWITCH_SYSTEM_TEMACS): Append -pg if profiling === modified file 'configure.ac' --- configure.ac 2013-06-03 19:38:06 +0000 +++ configure.ac 2013-06-05 04:38:04 +0000 @@ -776,6 +776,7 @@ # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-06 07:04:35 +0000 +++ src/ChangeLog 2013-06-06 15:40:14 +0000 @@ -1,5 +1,115 @@ 2013-06-06 Paul Eggert <eggert@cs.ucla.edu> + Use functions, not macros, for XINT etc. (Bug#11935). + In lisp.h, prefer functions to function-like macros, and + constants to object-like macros, when either will do. This: + . simplifies use, as there's no more need to worry about + arguments' side effects being evaluated multiple times. + . makes the code easier to debug on some platforms. + * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: + Remove enum lsb_bits; no longer needed. + (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue. + * buffer.c (Qoverlap): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + Now extern, so lisp.h can use these symbols. + * dispextern.h: Include character.h, for MAX_CHAR etc. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move here from lisp.h. + (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. + (GLYPH_MODE_LINE_FACE): Now enums, not macros. + * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since + XUNTAG now returns void *. + * lisp.h (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL) + (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, LISP_INT_TAG_P, MARKERP) + (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) + (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): + If compiling via GCC without optimization, inline these functions + manually, by defining macros in addition to inline functions. + To disable this, compile with -DINLINING=0. + (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise. + (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but + hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. + (INTMASK, VALMASK): Now macros, since static values cannot be + accessed from extern inline functions. + (VALMASK): Also a constant, for benefit of old GDB. + (LISP_INT_TAG_P, XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) + (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) + (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) + (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) + (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) + (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET) + (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF) + (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) + (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS) + (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) + (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) + (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) + (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE) + (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE) + (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE) + (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) + (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) + (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) + (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) + (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP) + (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP) + (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) + (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) + (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) + (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) + (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) + (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) + (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) + (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) + (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) + (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) + (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) + Now functions. + (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. + (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed. + (VALMASK): Define in one place rather than in two, merging the + USE_LSB_TAG parts; this is simpler. + (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM) + (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): + Move up, to avoid use before definition. + Also include "globals.h" earlier, for the same reason. + (make_natnum): New function. + (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. + (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) + (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) + (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) + (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) + (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) + (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) + (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) + (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) + (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) + (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) + (Qwindow_configuration_p, Qimage): New forward declarations. + (XSETFASTINT): Simplify by rewriting in terms of make_natnum. + (STRING_COPYIN): Remove; unused. + (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ... + (xcar_addr, xcdr_addr): New functions. All uses changed. + (IEEE_FLOATING_POINT): Now a constant, not a macro. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. + (TYPE_RANGED_INTEGERP): Simplify. + (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. + (setlocale, fixup_locale, synchronize_system_messages_locale) + (synchronize_system_time_locale) [!HAVE_SETLOCALE]: + Now empty functions, not macros. + (functionp): Return bool, not int. + * window.c (Qwindow_configuration_p): Now extern, + so window.h can use it. + * window.h (Qwindowp): Move decl back to lisp.h. + A few porting etc. fixes for the new file monitor code. See the thread containing <http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00109.html>. === modified file 'src/alloc.c' --- src/alloc.c 2013-06-03 09:01:53 +0000 +++ src/alloc.c 2013-06-05 04:38:04 +0000 @@ -3309,7 +3309,7 @@ --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; - XMISCTYPE (val) = type; + XMISCANY (val)->type = type; XMISCANY (val)->gcmarkbit = 0; return val; } @@ -3319,7 +3319,7 @@ void free_misc (Lisp_Object misc) { - XMISCTYPE (misc) = Lisp_Misc_Free; + XMISCANY (misc)->type = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); consing_since_gc -= sizeof (union Lisp_Misc); @@ -5647,7 +5647,7 @@ { CONS_MARK (XCONS (tail)); mark_object (XCAR (tail)); - prev = &XCDR_AS_LVALUE (tail); + prev = xcdr_addr (tail); } } mark_object (tail); @@ -6689,8 +6689,5 @@ enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; -#if USE_LSB_TAG - enum lsb_bits lsb_bits; -#endif } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ === modified file 'src/buffer.c' --- src/buffer.c 2013-05-07 14:12:57 +0000 +++ src/buffer.c 2013-06-05 04:38:04 +0000 @@ -134,7 +134,7 @@ static Lisp_Object Qget_file_buffer; -static Lisp_Object Qoverlayp; +Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; === modified file 'src/data.c' --- src/data.c 2013-06-03 18:29:30 +0000 +++ src/data.c 2013-06-05 04:38:04 +0000 @@ -76,7 +76,8 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -static Lisp_Object Qsubrp, Qmany, Qunevalled; +Lisp_Object Qsubrp; +static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; === modified file 'src/dispextern.h' --- src/dispextern.h 2013-05-04 10:19:13 +0000 +++ src/dispextern.h 2013-06-05 04:38:04 +0000 @@ -22,6 +22,8 @@ #ifndef DISPEXTERN_H_INCLUDED #define DISPEXTERN_H_INCLUDED +#include "character.h" + #ifdef HAVE_X_WINDOWS #include <X11/Xlib.h> @@ -270,6 +272,55 @@ Glyphs ***********************************************************************/ +/* The glyph datatype, used to represent characters on the display. + It consists of a char code and a face id. */ + +typedef struct { + int ch; + int face_id; +} GLYPH; + +/* Return a glyph's character code. */ +DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } + +/* Return a glyph's face ID. */ +DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } + +#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) +#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) +#define SET_GLYPH(glyph, char, face) \ + ((glyph).ch = (char), (glyph).face_id = (face)) + +/* The following are valid only if GLYPH_CODE_P (gc). */ + +DISPEXTERN_INLINE int +GLYPH_CODE_CHAR (Lisp_Object gc) +{ + return (CONSP (gc) + ? XINT (XCAR (gc)) + : XINT (gc) & MAX_CHAR); +} + +DISPEXTERN_INLINE int +GLYPH_CODE_FACE (Lisp_Object gc) +{ + return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; +} + +#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ + do \ + { \ + if (CONSP (gc)) \ + SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + else \ + SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ + (XINT (gc) >> CHARACTERBITS)); \ + } \ + while (0) + +/* The ID of the mode line highlighting face. */ +enum { GLYPH_MODE_LINE_FACE = 1 }; + /* Enumeration of glyph types. Glyph structures contain a type field containing one of the enumerators defined here. */ @@ -1774,6 +1825,30 @@ #endif /* not HAVE_WINDOW_SYSTEM */ +/* Return true if G contains a valid character code. */ +DISPEXTERN_INLINE bool +GLYPH_CHAR_VALID_P (GLYPH g) +{ + return CHAR_VALID_P (GLYPH_CHAR (g)); +} + +/* The glyph code from a display vector may either be an integer which + encodes a char code in the lower CHARACTERBITS bits and a (very small) + face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ + +DISPEXTERN_INLINE bool +GLYPH_CODE_P (Lisp_Object gc) +{ + return (CONSP (gc) + ? (CHARACTERP (XCAR (gc)) + && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_INTEGERP + (0, gc, + (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR + : TYPE_MAXIMUM (EMACS_INT))))); +} + /* Non-zero means face attributes have been changed since the last redisplay. Used in redisplay_internal. */ === modified file 'src/fns.c' --- src/fns.c 2013-04-08 18:04:58 +0000 +++ src/fns.c 2013-06-05 04:38:04 +0000 @@ -3335,7 +3335,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; +Lisp_Object Qhash_table_p; +static Lisp_Object Qkey, Qvalue, Qeql; Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; === modified file 'src/lisp.h' --- src/lisp.h 2013-06-05 12:17:02 +0000 +++ src/lisp.h 2013-06-06 15:49:27 +0000 @@ -220,6 +220,65 @@ #endif +/* When compiling via GCC without optimization, inline a few functions + manually, as Emacs is too slow otherwise. There's no need to + inline everything, just the functions that would cause a serious + performance problem when debugging. To disable this hand-optimization, + compile with -DINLINING=0. + + Commentary for these macros can be found near their corresponding + functions, below. */ +#if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ + && ! (defined INLINING && ! INLINING)) +# if CHECK_LISP_OBJECT_TYPE +# define XLI(o) (o).i +# define XIL(i) (Lisp_Object) { i } +# else +# define XLI(o) (o) +# define XIL(i) (i) +# endif +# define CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) +# define CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) +# define CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) +# define CHECK_TYPE(ok, Qxxxp, x) \ + ((void) ((ok) || wrong_type_argument (Qxxxp, x))) +# define CONSP(x) (XTYPE (x) == Lisp_Cons) +# define EQ(x, y) (XLI (x) == XLI (y)) +# define FLOATP(x) (XTYPE (x) == Lisp_Float) +# define INTEGERP(x) LISP_INT_TAG_P (XTYPE (x)) +# define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) +# define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) +# define MISCP(x) (XTYPE (x) == Lisp_Misc) +# define NILP(x) EQ (x, Qnil) +# define SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +# define SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +# define SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)) +# define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) +# define VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +# define XCAR(c) XCONS (c)->car +# define XCDR(c) XCONS (c)->u.cdr +# define XCONS(a) \ + (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +# define XHASH(a) XUINT (a) +# define XPNTR(a) ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) +# define XSYMBOL(a) \ + (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +# ifndef GC_CHECK_CONS_LIST +# define check_cons_list() ((void) 0) +# endif +# if USE_LSB_TAG +# define make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS) +# define XFASTINT(a) XINT (a) +# define XINT(a) (XLI (a) >> INTTYPEBITS) +# define XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) +# define XUNTAG(a, type) ((void *) (XLI (a) - (type))) +# endif +#endif + + /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. If you want to define a new @@ -230,7 +289,6 @@ 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 LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, and xlc complains vociferously about them. */ @@ -270,6 +328,8 @@ Lisp_Float = 7, }; +LISP_INLINE bool (LISP_INT_TAG_P) (int x) { return (x & ~Lisp_Int1) == 0; } + /* This is the set of data types that share a common structure. The first member of the structure is a type code from this set. The enum values are arbitrary, but we'll use large numbers to make it @@ -359,20 +419,15 @@ typedef struct { EMACS_INT i; } Lisp_Object; -#define XLI(o) (o).i +LISP_INLINE EMACS_INT (XLI) (Lisp_Object o) { return o.i; } + LISP_INLINE Lisp_Object -XIL (EMACS_INT i) +(XIL) (EMACS_INT i) { Lisp_Object o = { i }; return o; } -LISP_INLINE Lisp_Object -LISP_MAKE_RVALUE (Lisp_Object o) -{ - return o; -} - #define LISP_INITIALLY_ZERO {0} #undef CHECK_LISP_OBJECT_TYPE @@ -382,9 +437,8 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -#define XLI(o) (o) -#define XIL(i) (i) -#define LISP_MAKE_RVALUE(o) (0 + (o)) +LISP_INLINE EMACS_INT (XLI) (Lisp_Object o) { return o; } +LISP_INLINE Lisp_Object (XIL) (EMACS_INT i) { return i; } #define LISP_INITIALLY_ZERO 0 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; #endif /* CHECK_LISP_OBJECT_TYPE */ @@ -460,84 +514,96 @@ BOOL_VECTOR_BITS_PER_CHAR = 8 }; \f -/* These macros extract various sorts of values from a Lisp_Object. +/* These functions extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -#if USE_LSB_TAG - -enum lsb_bits - { - TYPEMASK = (1 << GCTYPEBITS) - 1, - VALMASK = ~ TYPEMASK - }; -#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) -#define XINT(a) (XLI (a) >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) -#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) -#define make_lisp_ptr(ptr, type) \ - (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ - XIL ((type) | (intptr_t) (ptr))) - -#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) -#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) - -#else /* not USE_LSB_TAG */ - static EMACS_INT const VALMASK -#define VALMASK VAL_MAX +#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) = VALMASK; -#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp integers have zero-bits in their tags. */ -#define XFASTINT(a) (XLI (a) + 0) -#define XSETFASTINT(a, b) ((a) = XIL (b)) - -/* Extract the value of a Lisp_Object as a (un)signed integer. */ - -#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) -#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) - -#define make_lisp_ptr(ptr, type) \ - (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object. */ -#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) - -#endif /* not USE_LSB_TAG */ +/* 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) + +LISP_INLINE enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; +} + +/* Extract the value of a Lisp_Object as a signed integer. */ +LISP_INLINE EMACS_INT +(XINT) (Lisp_Object a) +{ + EMACS_INT i = XLI (a); + return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; +} + +/* Like XINT (A), but may be faster. A must be nonnegative. This takes + advantage of the fact that Lisp integers have zero-bits in their tags. */ +LISP_INLINE EMACS_INT +(XFASTINT) (Lisp_Object a) +{ + EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) >> INTTYPEBITS; + eassert (0 <= n); + return n; +} + +/* Extract the value of a Lisp_Object as an unsigned integer. */ +LISP_INLINE EMACS_UINT +XUINT (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; +} /* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be like XUINT right now, but XUINT should only be applied to objects we know are integers. */ -#define XHASH(a) XUINT (a) - -/* For integers known to be positive, XFASTINT sometimes provides - faster retrieval and XSETFASTINT provides faster storage. - If not, fallback on the non-accelerated path. */ -#ifndef XFASTINT -# define XFASTINT(a) (XINT (a)) -# define XSETFASTINT(a, b) (XSETINT (a, b)) -#endif +LISP_INLINE EMACS_INT (XHASH) (Lisp_Object a) { return XUINT (a); } + +LISP_INLINE Lisp_Object +(make_number) (EMACS_INT n) +{ + return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); +} + +/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +LISP_INLINE Lisp_Object +make_natnum (EMACS_INT n) +{ + eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); + return USE_LSB_TAG ? make_number (n) : XIL (n); +} + +LISP_INLINE void * +(XPNTR) (Lisp_Object a) +{ + intptr_t i = (XLI (a) & VALMASK) | DATA_SEG_BITS; + return (void *) i; +} /* Extract the pointer value of the Lisp object A, under the - assumption that A's type is TYPE. This is a fallback - implementation if nothing faster is available. */ -#ifndef XUNTAG -# define XUNTAG(a, type) XPNTR (a) -#endif - -#define EQ(x, y) (XLI (x) == XLI (y)) - -/* 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) + assumption that A's type is TYPE. */ +LISP_INLINE void * +(XUNTAG) (Lisp_Object a, int type) +{ + if (USE_LSB_TAG) + { + intptr_t i = XLI (a) - type; + return (void *) i; + } + return XPNTR (a); +} + +LISP_INLINE bool +(EQ) (Lisp_Object x, Lisp_Object y) +{ + return XLI (x) == XLI (y); +} /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned @@ -551,66 +617,193 @@ { return num < lower ? lower : num <= upper ? num : upper; } - -\f +\f +/* Forward declarations. */ + +/* Defined in this file. */ +union Lisp_Fwd; +LISP_INLINE bool BOOLFWDP (union Lisp_Fwd *); +LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); +LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool BUFFERP (Lisp_Object); +LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); +LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); +LISP_INLINE bool (CONSP) (Lisp_Object); +LISP_INLINE bool (FLOATP) (Lisp_Object); +LISP_INLINE bool functionp (Lisp_Object); +LISP_INLINE bool (INTEGERP) (Lisp_Object); +LISP_INLINE bool INTFWDP (union Lisp_Fwd *); +LISP_INLINE bool KBOARD_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool (MARKERP) (Lisp_Object); +LISP_INLINE bool (MISCP) (Lisp_Object); +LISP_INLINE bool (NILP) (Lisp_Object); +LISP_INLINE bool OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool OVERLAYP (Lisp_Object); +LISP_INLINE bool PROCESSP (Lisp_Object); +LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); +LISP_INLINE bool SAVE_VALUEP (Lisp_Object); +LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, + Lisp_Object); +LISP_INLINE bool STRINGP (Lisp_Object); +LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); +LISP_INLINE bool SUBRP (Lisp_Object); +LISP_INLINE bool (SYMBOLP) (Lisp_Object); +LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); +LISP_INLINE bool WINDOWP (Lisp_Object); +LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + +/* Defined in buffer.c. */ +extern Lisp_Object Qoverlayp; + +/* Defined in chartab.c. */ +extern Lisp_Object char_table_ref (Lisp_Object, int); +extern void char_table_set (Lisp_Object, int, Lisp_Object); +extern int char_table_translate (Lisp_Object, int); + +/* Defined in data.c. */ +extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; +extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; +extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qvector_or_char_table_p, Qwholenump; +extern Lisp_Object Ffboundp (Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + +/* Defined in emacs.c. */ +extern bool initialized; + +/* Defined in eval.c. */ +extern Lisp_Object Qautoload; + +/* Defined in fns.c */ +extern Lisp_Object Qhash_table_p; + +/* Defined in floatfns.c. */ +extern double extract_float (Lisp_Object); + +/* Defined in process.c. */ +extern Lisp_Object Qprocessp; + +/* Defined in window.c. */ +extern Lisp_Object Qwindowp, Qwindow_configuration_p; + +/* Defined in xdisp.c. */ +extern Lisp_Object Qimage; +\f + /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) -#define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) - -/* Misc types. */ - -#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) -#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) -#define XMISCTYPE(a) (XMISCANY (a)->type) -#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) -#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) - -/* Forwarding object types. */ - -#define XFWDTYPE(a) (a->u_intfwd.type) -#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) -#define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) -#define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) +LISP_INLINE struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + eassert (CONSP (a)); + return XUNTAG (a, Lisp_Cons); +} + +LISP_INLINE struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + +LISP_INLINE struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ + eassert (SYMBOLP (a)); + return XUNTAG (a, Lisp_Symbol); +} + +LISP_INLINE struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} /* Pseudovector types. */ -struct Lisp_Process; -LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) -{ return make_lisp_ptr (p, Lisp_Vectorlike); } -#define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) -#define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ - ((struct Lisp_Bool_Vector *) \ - XUNTAG (a, Lisp_Vectorlike))) + +LISP_INLINE struct Lisp_Process * +XPROCESS (Lisp_Object a) +{ + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct window * +XWINDOW (Lisp_Object a) +{ + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct terminal * +XTERMINAL (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct buffer * +XBUFFER (Lisp_Object a) +{ + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Sub_Char_Table * +XSUB_CHAR_TABLE (Lisp_Object a) +{ + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_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. */ +LISP_INLINE Lisp_Object +make_lisp_ptr (void *ptr, enum Lisp_Type type) +{ + EMACS_UINT utype = type; + EMACS_INT typebits = USE_LSB_TAG ? type : utype << VALBITS; + Lisp_Object a = XIL (typebits | (intptr_t) ptr); + eassert (XUNTAG (a, type) == ptr); /* Check alignment. */ + return a; +} + +LISP_INLINE Lisp_Object +make_lisp_proc (struct Lisp_Process *p) +{ + return make_lisp_ptr (p, Lisp_Vectorlike); +} + #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)) @@ -656,35 +849,14 @@ #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -/* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -#define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) - -/* Convenience macros for dealing with Lisp strings. */ - -#define SDATA(string) (XSTRING (string)->data + 0) -#define SREF(string, index) (SDATA (string)[index] + 0) -#define SSET(string, index, new) (SDATA (string)[index] = (new)) -#define SCHARS(string) (XSTRING (string)->size + 0) -#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - -/* Avoid "differ in sign" warnings. */ -#define SSDATA(x) ((char *) SDATA (x)) - -#define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - -#define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ -#define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) +LISP_INLINE void +(CHECK_TYPE) (int ok, Lisp_Object Qxxxp, Lisp_Object x) +{ + if (!ok) + wrong_type_argument (Qxxxp, x); +} /* Deprecated and will be removed soon. */ @@ -695,8 +867,11 @@ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type. */ -#define CHECK_STRING_OR_BUFFER(x) \ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) +LISP_INLINE void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} struct Lisp_Cons { @@ -714,64 +889,78 @@ }; /* Take the car or cdr of something known to be a cons cell. */ -/* The _AS_LVALUE macros shouldn't be used outside of the minimal set +/* 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 as lvalues. (What if we want to switch to + 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.) */ -#define XCAR_AS_LVALUE(c) (XCONS (c)->car) -#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) +LISP_INLINE Lisp_Object *xcar_addr (Lisp_Object c) { return &XCONS (c)->car; } +LISP_INLINE Lisp_Object *xcdr_addr (Lisp_Object c) { return &XCONS (c)->u.cdr; } /* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) +LISP_INLINE Lisp_Object (XCAR) (Lisp_Object c) { return *xcar_addr (c); } +LISP_INLINE Lisp_Object (XCDR) (Lisp_Object c) { return *xcdr_addr (c); } /* Use these to set the fields of a cons cell. Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR(c) \ - (CONSP ((c)) ? XCAR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -#define CDR(c) \ - (CONSP ((c)) ? XCDR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR_SAFE(c) \ - (CONSP ((c)) ? XCAR ((c)) : Qnil) - -#define CDR_SAFE(c) \ - (CONSP ((c)) ? XCDR ((c)) : Qnil) + should not be read after 'c' is first modified. */ +LISP_INLINE void +XSETCAR (Lisp_Object c, Lisp_Object n) +{ + *xcar_addr (c) = n; +} +LISP_INLINE void +XSETCDR (Lisp_Object c, Lisp_Object n) +{ + *xcdr_addr (c) = n; +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR (Lisp_Object c) +{ + return (CONSP (c) ? XCAR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} +LISP_INLINE Lisp_Object +CDR (Lisp_Object c) +{ + return (CONSP (c) ? XCDR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCAR (c) : Qnil; +} +LISP_INLINE Lisp_Object +CDR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCDR (c) : Qnil; +} + +/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; /* True if STR is a multibyte string. */ -#define STRING_MULTIBYTE(STR) \ - (XSTRING (STR)->size_byte >= 0) - -/* Return the length in bytes of STR. */ - -#ifdef GC_CHECK_STRING_BYTES - -struct Lisp_String; -extern ptrdiff_t string_bytes (struct Lisp_String *); -#define STRING_BYTES(S) string_bytes ((S)) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define STRING_BYTES(STR) \ - ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) - -#endif /* not GC_CHECK_STRING_BYTES */ +LISP_INLINE bool +STRING_MULTIBYTE (Lisp_Object str) +{ + return 0 <= XSTRING (str)->size_byte; +} /* An upper bound on the number of bytes in a Lisp string, not counting the terminating null. This a tight enough bound to @@ -802,20 +991,65 @@ (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ +/* Convenience functions for dealing with Lisp strings. */ -struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; +LISP_INLINE unsigned char * +SDATA (Lisp_Object string) +{ + return XSTRING (string)->data; +} +LISP_INLINE char * +SSDATA (Lisp_Object string) +{ + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); +} +LISP_INLINE unsigned char +SREF (Lisp_Object string, ptrdiff_t index) +{ + return SDATA (string)[index]; +} +LISP_INLINE void +SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) +{ + SDATA (string)[index] = new; +} +LISP_INLINE ptrdiff_t +SCHARS (Lisp_Object string) +{ + return XSTRING (string)->size; +} +LISP_INLINE ptrdiff_t +STRING_BYTES (struct Lisp_String *s) +{ +#ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + return string_bytes (s); +#else + return s->size_byte < 0 ? s->size : s->size_byte; +#endif +} +LISP_INLINE ptrdiff_t +SBYTES (Lisp_Object string) +{ + return STRING_BYTES (XSTRING (string)); +} +LISP_INLINE void +STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) +{ + XSTRING (string)->size = newsize; +} +LISP_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 - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ @@ -874,6 +1108,42 @@ word_size = sizeof (Lisp_Object) }; +/* Conveniences for dealing with Lisp arrays. */ + +LISP_INLINE Lisp_Object +AREF (Lisp_Object array, ptrdiff_t idx) +{ + return XVECTOR (array)->contents[idx]; +} + +LISP_INLINE Lisp_Object * +aref_addr (Lisp_Object array, ptrdiff_t idx) +{ + return & XVECTOR (array)->contents[idx]; +} + +LISP_INLINE ptrdiff_t +ASIZE (Lisp_Object array) +{ + return XVECTOR (array)->header.size; +} + +LISP_INLINE void +ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + eassert (0 <= idx && idx < ASIZE (array)); + XVECTOR (array)->contents[idx] = val; +} + +LISP_INLINE void +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)); + XVECTOR (array)->contents[idx] = val; +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ @@ -887,43 +1157,6 @@ #define PSEUDOVECSIZE(type, nonlispfield) \ ((offsetof (type, nonlispfield) - header_size) / word_size) -/* A char-table is a kind of vectorlike, with contents are like a - vector but with a few other slots. For some purposes, it makes - sense to handle a char-table with type struct Lisp_Vector. An - element of a char table can be any Lisp objects, but if it is a sub - char-table, we treat it a table that contains information of a - specific range of characters. A sub char-table has the same - structure as a vector. A sub char table appears only in an element - of a char-table, and there's no way to access it directly from - Emacs Lisp program. */ - -#ifdef __GNUC__ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - ({struct Lisp_Char_Table *_tbl = NULL; \ - Lisp_Object _val; \ - do { \ - _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ - _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ - : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ - if (NILP (_val)) \ - _val = _tbl->defalt; \ - } while (NILP (_val) && ! NILP (_tbl->parent)); \ - _val; }) - -#else /* not __GNUC__ */ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - (! NILP (XCHAR_TABLE (CT)->ascii) \ - ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XCHAR_TABLE (CT)->ascii \ - : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ - : char_table_ref ((CT), (IDX))) \ - : char_table_ref ((CT), (IDX))) - -#endif /* not __GNUC__ */ - /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) @@ -937,18 +1170,15 @@ /* Nonzero iff C is an ASCII character. */ #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - characters. Do not check validity of CT. */ -#define CHAR_TABLE_REF(CT, IDX) \ - (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ - : char_table_ref ((CT), (IDX))) - -/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit European characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \ - : char_table_set (CT, IDX, VAL)) +/* A char-table is a kind of vectorlike, with contents are like a + vector but with a few other slots. For some purposes, it makes + sense to handle a char-table with type struct Lisp_Vector. An + element of a char table can be any Lisp objects, but if it is a sub + char-table, we treat it a table that contains information of a + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ enum CHARTAB_SIZE_BITS { @@ -1012,6 +1242,45 @@ Lisp_Object contents[1]; }; +LISP_INLINE Lisp_Object +CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) +{ + struct Lisp_Char_Table *tbl = NULL; + Lisp_Object val; + do + { + tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); + val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii + : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + if (NILP (val)) + val = tbl->defalt; + } + while (NILP (val) && ! NILP (tbl->parent)); + + return val; +} + +/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII + characters. Do not check validity of CT. */ +LISP_INLINE Lisp_Object +CHAR_TABLE_REF (Lisp_Object ct, int idx) +{ + return (ASCII_CHAR_P (idx) + ? CHAR_TABLE_REF_ASCII (ct, idx) + : char_table_ref (ct, idx)); +} + +/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and + 8-bit European characters. Do not check validity of CT. */ +LISP_INLINE void +CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) +{ + if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) + set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val); + else + 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. */ @@ -1048,8 +1317,12 @@ /* Return the number of "extra" slots in the char table CT. */ -#define CHAR_TABLE_EXTRA_SLOTS(CT) \ - (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) +LISP_INLINE int +CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) +{ + return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) + - CHAR_TABLE_STANDARD_SLOTS); +} \f /*********************************************************************** @@ -1121,40 +1394,86 @@ /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) -#define SYMBOL_ALIAS(sym) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) - -#define SYMBOL_NAME(sym) XSYMBOL (sym)->name - -/* Value is non-zero if SYM is an interned symbol. */ - -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) - -/* Value is non-zero if SYM is interned in initial_obarray. */ - -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +LISP_INLINE Lisp_Object +(SYMBOL_VAL) (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_PLAINVAL); + return sym->val.value; +} +LISP_INLINE struct Lisp_Symbol * +SYMBOL_ALIAS (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + return sym->val.alias; +} +LISP_INLINE struct Lisp_Buffer_Local_Value * +SYMBOL_BLV (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + return sym->val.blv; +} +LISP_INLINE union Lisp_Fwd * +SYMBOL_FWD (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + return sym->val.fwd; +} +LISP_INLINE void +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +{ + eassert (sym->redirect == SYMBOL_PLAINVAL); + sym->val.value = v; +} +LISP_INLINE void +SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + sym->val.alias = v; +} +LISP_INLINE void +SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + sym->val.blv = v; +} +LISP_INLINE void +SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + sym->val.fwd = v; +} + +LISP_INLINE Lisp_Object +SYMBOL_NAME (Lisp_Object sym) +{ + return XSYMBOL (sym)->name; +} + +/* Value is true if SYM is an interned symbol. */ + +LISP_INLINE bool +SYMBOL_INTERNED_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; +} + +/* Value is true if SYM is interned in initial_obarray. */ + +LISP_INLINE bool +SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; +} /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +LISP_INLINE int +(SYMBOL_CONSTANT_P) (Lisp_Object sym) +{ + return XSYMBOL (sym)->constant; +} #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1240,42 +1559,69 @@ }; -#define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) +LISP_INLINE struct Lisp_Hash_Table * +XHASH_TABLE (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) - -#define CHECK_HASH_TABLE(x) \ - CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) +LISP_INLINE bool +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} +LISP_INLINE void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} /* Value is the key part of entry IDX in hash table H. */ - -#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) +LISP_INLINE Lisp_Object +HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx); +} /* Value is the value part of entry IDX in hash table H. */ - -#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) +LISP_INLINE Lisp_Object +HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx + 1); +} /* Value is the index of the next entry following the one at IDX in hash table H. */ - -#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) +LISP_INLINE Lisp_Object +HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->next, idx); +} /* Value is the hash code computed for entry IDX in hash table H. */ - -#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) +LISP_INLINE Lisp_Object +HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->hash, idx); +} /* Value is the index of the element in hash table H that is the start of the collision list at index IDX in the index vector of H. */ - -#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) +LISP_INLINE Lisp_Object +HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->index, idx); +} /* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) +LISP_INLINE ptrdiff_t +HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) +{ + return ASIZE (h->next); +} /* Default size for hash tables if not specified. */ @@ -1485,6 +1831,53 @@ } data[SAVE_VALUE_SLOTS]; }; +/* Return the type of V's Nth saved value. */ +LISP_INLINE int +save_type (struct Lisp_Save_Value *v, int n) +{ + eassert (0 <= n && n < SAVE_VALUE_SLOTS); + return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); +} + +/* Get and set the Nth saved pointer. */ + +LISP_INLINE void * +XSAVE_POINTER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + return XSAVE_VALUE (obj)->data[n].pointer;; +} +LISP_INLINE void +set_save_pointer (Lisp_Object obj, int n, void *val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + XSAVE_VALUE (obj)->data[n].pointer = val; +} + +/* Likewise for the saved integer. */ + +LISP_INLINE ptrdiff_t +XSAVE_INTEGER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + return XSAVE_VALUE (obj)->data[n].integer; +} +LISP_INLINE void +set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + XSAVE_VALUE (obj)->data[n].integer = val; +} + +/* Extract Nth saved object. */ + +LISP_INLINE Lisp_Object +XSAVE_OBJECT (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); + return XSAVE_VALUE (obj)->data[n].object; +} + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -1506,6 +1899,46 @@ struct Lisp_Save_Value u_save_value; }; +LISP_INLINE union Lisp_Misc * +XMISC (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Misc); +} + +LISP_INLINE struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return & XMISC (a)->u_any; +} + +LISP_INLINE enum Lisp_Misc_Type +XMISCTYPE (Lisp_Object a) +{ + return XMISCANY (a)->type; +} + +LISP_INLINE struct Lisp_Marker * +XMARKER (Lisp_Object a) +{ + eassert (MARKERP (a)); + return & XMISC (a)->u_marker; +} + +LISP_INLINE struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) +{ + eassert (OVERLAYP (a)); + return & XMISC (a)->u_overlay; +} + +LISP_INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} +\f /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1612,6 +2045,47 @@ struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; + +LISP_INLINE enum Lisp_Fwd_Type +XFWDTYPE (union Lisp_Fwd *a) +{ + return a->u_intfwd.type; +} + +LISP_INLINE struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} + +LISP_INLINE struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} + +LISP_INLINE struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +LISP_INLINE struct Lisp_Buffer_Objfwd * +XBUFFER_OBJFWD (union Lisp_Fwd *a) +{ + eassert (BUFFER_OBJFWDP (a)); + return &a->u_buffer_objfwd; +} + +LISP_INLINE struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} \f /* Lisp floating point type. */ struct Lisp_Float @@ -1623,8 +2097,17 @@ } u; }; -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) -#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) +LISP_INLINE double +XFLOAT_DATA (Lisp_Object f) +{ + return XFLOAT (f)->u.data; +} + +LISP_INLINE void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on @@ -1633,8 +2116,12 @@ wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) +enum + { + IEEE_FLOATING_POINT + = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) + }; /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ @@ -1675,64 +2162,6 @@ itself. */ CHARACTERBITS = 22 }; - - - -\f -/* The glyph datatype, used to represent characters on the display. - It consists of a char code and a face id. */ - -typedef struct { - int ch; - int face_id; -} GLYPH; - -/* Return a glyph's character code. */ -#define GLYPH_CHAR(glyph) ((glyph).ch) - -/* Return a glyph's face ID. */ -#define GLYPH_FACE(glyph) ((glyph).face_id) - -#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) -#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) -#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) - -/* Return 1 if GLYPH contains valid character code. */ -#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) - - -/* Glyph Code from a display vector may either be an integer which - encodes a char code in the lower CHARACTERBITS bits and a (very small) - face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ - -#define GLYPH_CODE_P(gc) \ - (CONSP (gc) \ - ? (CHARACTERP (XCAR (gc)) \ - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ - : (RANGED_INTEGERP \ - (0, gc, \ - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ - ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ - : TYPE_MAXIMUM (EMACS_INT))))) - -/* The following are valid only if GLYPH_CODE_P (gc). */ - -#define GLYPH_CODE_CHAR(gc) \ - (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) - -#define GLYPH_CODE_FACE(gc) \ - (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) - -#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ - do \ - { \ - if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ - else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ - } \ - while (0) \f /* Structure to hold mouse highlight data. This is here because other header files need it for defining struct x_output etc. */ @@ -1768,190 +2197,305 @@ \f /* Data type checking. */ -#define NILP(x) EQ (x, Qnil) - -#define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) - -#define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) +LISP_INLINE bool +(NILP) (Lisp_Object x) +{ + return EQ (x, Qnil); +} + +LISP_INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x); +} +LISP_INLINE bool +NATNUMP (Lisp_Object x) +{ + return INTEGERP (x) && 0 <= XINT (x); +} + +LISP_INLINE bool +RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +{ + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; +} + #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - -#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) -#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - -#define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) -#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) - + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + +LISP_INLINE bool (CONSP) (Lisp_Object x) { return XTYPE (x) == Lisp_Cons; } +LISP_INLINE bool (FLOATP) (Lisp_Object x) { return XTYPE (x) == Lisp_Float; } +LISP_INLINE bool (MISCP) (Lisp_Object x) { return XTYPE (x) == Lisp_Misc; } +LISP_INLINE bool STRINGP (Lisp_Object x) { return XTYPE (x) == Lisp_String; } +LISP_INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return XTYPE (x) == Lisp_Symbol; +} +LISP_INLINE bool +(INTEGERP) (Lisp_Object x) +{ + return LISP_INT_TAG_P (XTYPE (x)); +} +LISP_INLINE bool +(VECTORLIKEP) (Lisp_Object x) +{ + return XTYPE (x) == Lisp_Vectorlike; +} +LISP_INLINE bool +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} +LISP_INLINE bool +OVERLAYP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; +} +LISP_INLINE bool +(MARKERP) (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker; +} LISP_INLINE bool SAVE_VALUEP (Lisp_Object x) { return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; } -LISP_INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; -} - -/* Return the type of V's Nth saved value. */ -LISP_INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -LISP_INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer;; -} -LISP_INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} - -/* Likewise for the saved integer. */ - -LISP_INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -LISP_INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -LISP_INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - -#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) - -#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) -#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) -#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) -#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) -#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - -/* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ -#define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) - -#define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) - -/* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ -#define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) +LISP_INLINE bool +AUTOLOADP (Lisp_Object x) +{ + return CONSP (x) && EQ (Qautoload, XCAR (x)); +} + +LISP_INLINE bool +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +LISP_INLINE bool +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +LISP_INLINE bool +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} +LISP_INLINE bool +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} +LISP_INLINE bool +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} + +LISP_INLINE bool +PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) +{ + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +LISP_INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } +} + /* Test for specific pseudovector types. */ -#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) -#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) + +LISP_INLINE bool +WINDOW_CONFIGURATIONP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); +} + +LISP_INLINE bool +PROCESSP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_PROCESS); +} + +LISP_INLINE bool +WINDOWP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW); +} + +LISP_INLINE bool +TERMINALP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TERMINAL); +} + +LISP_INLINE bool +SUBRP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUBR); +} + +LISP_INLINE bool +COMPILEDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_COMPILED); +} + +LISP_INLINE bool +BUFFERP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BUFFER); +} + +LISP_INLINE bool +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +LISP_INLINE bool +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); +} + +LISP_INLINE bool +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +LISP_INLINE bool +FRAMEP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_FRAME); +} /* Test for image (image . spec) */ -#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +LISP_INLINE bool +IMAGEP (Lisp_Object x) +{ + return CONSP (x) && EQ (XCAR (x), Qimage); +} /* Array types. */ - -#define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) +LISP_INLINE bool +ARRAYP (Lisp_Object x) +{ + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); +} \f -#define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - -#define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - -#define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - -#define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - -#define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - -#define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - -#define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - -#define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - -#define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - -#define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - -#define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - -#define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - -#define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - -#define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - -#define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - -#define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) - -#define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) - -#define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) +LISP_INLINE void +CHECK_LIST (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); +} +LISP_INLINE void +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (CONSP (x), Qlistp, y); +} +LISP_INLINE void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} +LISP_INLINE void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} +LISP_INLINE void +CHECK_STRING_CAR (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); +} +LISP_INLINE void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} +LISP_INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + CHECK_TYPE (SYMBOLP (x), Qsymbolp, x); +} +LISP_INLINE void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} +LISP_INLINE void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_STRING (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); +} +LISP_INLINE void +CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +{ + CHECK_TYPE (ARRAYP (x), Qxxxp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} +LISP_INLINE void +CHECK_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (BUFFERP (x), Qbufferp, x); +} +LISP_INLINE void +CHECK_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x), Qwindowp, x); +} +LISP_INLINE void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} +LISP_INLINE void +CHECK_PROCESS (Lisp_Object x) +{ + CHECK_TYPE (PROCESSP (x), Qprocessp, x); +} +LISP_INLINE void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} +LISP_INLINE void +(CHECK_NUMBER) (Lisp_Object x) +{ + CHECK_TYPE (INTEGERP (x), Qintegerp, x); +} +LISP_INLINE void +CHECK_NATNUM (Lisp_Object x) +{ + CHECK_TYPE (NATNUMP (x), Qwholenump, x); +} #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@ -1972,57 +2516,76 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -#define CHECK_MARKER(x) \ - CHECK_TYPE (MARKERP (x), Qmarkerp, x) +LISP_INLINE void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) -#define XFLOATINT(n) extract_float((n)) - -#define CHECK_FLOAT(x) \ - CHECK_TYPE (FLOATP (x), Qfloatp, x) - -#define CHECK_NUMBER_OR_FLOAT(x) \ - CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) +LISP_INLINE double +XFLOATINT (Lisp_Object n) +{ + return extract_float (n); +} + +LISP_INLINE void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} +LISP_INLINE void +CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); +} #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -#define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) +LISP_INLINE void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ -#define CHECK_NUMBER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) +LISP_INLINE void +CHECK_NUMBER_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NUMBER_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} \f /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2088,8 +2651,12 @@ #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* Non-zero if OBJ is a Lisp function. */ -#define FUNCTIONP(OBJ) functionp(OBJ) +/* True if OBJ is a Lisp function. */ +LISP_INLINE bool +FUNCTIONP (Lisp_Object obj) +{ + return functionp (obj); +} /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ @@ -2276,7 +2843,11 @@ extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +LISP_INLINE ptrdiff_t +SPECPDL_INDEX (void) +{ + return specpdl_ptr - specpdl; +} /* Everything needed to describe an active condition case. @@ -2592,27 +3163,12 @@ #define EXFUN(fnname, maxargs) \ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs +#include "globals.h" + /* Forward declarations for prototypes. */ struct window; struct frame; -/* Simple access functions. */ - -LISP_INLINE Lisp_Object * -aref_addr (Lisp_Object array, ptrdiff_t idx) -{ - return & XVECTOR (array)->contents[idx]; -} - -LISP_INLINE void -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)); - XVECTOR (array)->contents[idx] = val; -} - /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ LISP_INLINE void @@ -2849,6 +3405,7 @@ extern Lisp_Object Qbuffer, Qinteger, Qsymbol; +extern Lisp_Object Qsubrp; extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; @@ -3237,7 +3794,7 @@ #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); #else -#define check_cons_list() ((void) 0) +LISP_INLINE void (check_cons_list) (void) {} #endif #ifdef REL_ALLOC @@ -3305,10 +3862,12 @@ extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); -#define LOADHIST_ATTACH(x) \ - do { \ - if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ - } while (0) +LISP_INLINE void +LOADHIST_ATTACH (Lisp_Object x) +{ + if (initialized) + Vcurrent_load_list = Fcons (x, Vcurrent_load_list); +} extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object); extern Lisp_Object string_to_number (char const *, int, bool); @@ -3431,6 +3990,7 @@ extern Lisp_Object Vbuffer_alist; extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); +extern Lisp_Object Qoverlayp; extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); extern void init_buffer_once (void); @@ -3594,10 +4154,10 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -#define setlocale(category, locale) -#define fixup_locale() -#define synchronize_system_messages_locale() -#define synchronize_system_time_locale() +LISP_INLINE char *setlocale (int cat, char const *locale) { return 0; } +LISP_INLINE void fixup_locale (void) {} +LISP_INLINE void synchronize_system_messages_locale (void) {} +LISP_INLINE void synchronize_system_time_locale (void) {} #endif extern void shut_down_emacs (int, Lisp_Object); @@ -3956,8 +4516,6 @@ } while (0) -#include "globals.h" - /* Check whether it's time for GC, and run it if so. */ LISP_INLINE void @@ -3970,7 +4528,7 @@ Fgarbage_collect (); } -LISP_INLINE int +LISP_INLINE bool functionp (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) === modified file 'src/window.c' --- src/window.c 2013-06-04 16:33:46 +0000 +++ src/window.c 2013-06-05 04:38:04 +0000 @@ -55,7 +55,8 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_valid_p; -static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; +Lisp_Object Qwindow_configuration_p; +static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; === modified file 'src/window.h' --- src/window.h 2013-03-28 14:04:49 +0000 +++ src/window.h 2013-04-03 17:23:06 +0000 @@ -958,7 +958,7 @@ /* These used to be in lisp.h. */ -extern Lisp_Object Qwindowp, Qwindow_live_p; +extern Lisp_Object Qwindow_live_p; extern Lisp_Object Vwindow_list; extern struct window *decode_live_window (Lisp_Object); ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-06 15:56 ` Paul Eggert @ 2013-06-06 16:36 ` Andreas Schwab 2013-06-13 16:30 ` Paul Eggert 2013-06-06 16:42 ` Stefan Monnier 1 sibling, 1 reply; 41+ messages in thread From: Andreas Schwab @ 2013-06-06 16:36 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 Paul Eggert <eggert@cs.ucla.edu> writes: > -#define CHECK_OVERLAY(x) \ > - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) > +LISP_INLINE void > +CHECK_OVERLAY (Lisp_Object x) > +{ > + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); > +} Since it's only used in buffer.c it should be moved there. Andreas. -- Andreas Schwab, schwab@linux-m68k.org GPG Key fingerprint = 58CA 54C7 6D53 942B 1756 01D3 44D5 214B 8276 4ED5 "And now for something completely different." ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-06 16:36 ` Andreas Schwab @ 2013-06-13 16:30 ` Paul Eggert 0 siblings, 0 replies; 41+ messages in thread From: Paul Eggert @ 2013-06-13 16:30 UTC (permalink / raw) To: Andreas Schwab; +Cc: 11935 [-- Attachment #1: Type: text/plain, Size: 514 bytes --] On 06/06/13 09:36, Andreas Schwab wrote: > Since it's only used in buffer.c it should be moved there. Yes, that's a win, as it makes it clearer to the human reader that the function is used and needed only by one module, and it simplifies lisp.h. Attached is a patch to do that systematically for lisp.h; it assumes the patch I sent out earlier today <http://bugs.gnu.org/11935#110>. A side effect is that this gives GCC -O2 a bit more chance to optimize, shrinking the executable by 3k on my x86-64 platform. [-- Attachment #2: inline4o.diff --] [-- Type: text/x-patch, Size: 26453 bytes --] === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-13 14:17:41 +0000 +++ src/ChangeLog 2013-06-13 16:27:13 +0000 @@ -1,5 +1,38 @@ 2013-06-13 Paul Eggert <eggert@cs.ucla.edu> + Move functions from lisp.h to individual modules when possible. + From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>. + * alloc.c (XFLOAT_INIT, set_symbol_name): + * buffer.c (CHECK_OVERLAY): + * chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii) + (set_char_table_parent): + * coding.c (CHECK_NATNUM_CAR, CHECK_NATNUM_CDR): + * data.c (BOOLFWDP, INTFWDP, KBOARD_OBJFWDP, OBJFWDP, XBOOLFWD) + (XKBOARD_OBJFWD, XINTFWD, XOBJFWD, CHECK_SUBR, set_blv_found) + (blv_value, set_blv_value, set_blv_where, set_blv_defcell) + (set_blv_valcell): + * emacs.c (setlocale) [!HAVE_SETLOCALE]: + * eval.c (specpdl_symbol, specpdl_old_value, specpdl_where) + (specpdl_arg, specpdl_func, backtrace_function, backtrace_nargs) + (backtrace_args, backtrace_debug_on_exit): + * floatfns.c (CHECK_FLOAT): + * fns.c (CHECK_HASH_TABLE, CHECK_LIST_END) + (set_hash_key_and_value, set_hash_next, set_hash_next_slot) + (set_hash_hash, set_hash_hash_slot, set_hash_index) + (set_hash_index_slot): + * keymap.c (CHECK_VECTOR_OR_CHAR_TABLE): + * marker.c (CHECK_MARKER): + * textprop.c (CHECK_STRING_OR_BUFFER): + * window.c (CHECK_WINDOW_CONFIGURATION): + Move here from lisp.h, and make these functions static rather than + extern inline. + * buffer.c (Qoverlayp): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + * window.c (Qwindow_configuration_p): + Now static. + * lisp.h: Remove the abovementioned defns and decls. + Use functions, not macros, for XINT etc. (Bug#11935). In lisp.h, prefer functions to function-like macros, and constants to object-like macros, when either will do. This: === modified file 'src/alloc.c' --- src/alloc.c 2013-06-05 04:38:04 +0000 +++ src/alloc.c 2013-06-13 15:38:41 +0000 @@ -363,6 +363,11 @@ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ & ~ ((ALIGNMENT) - 1))) +static void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} \f /************************************************************************ @@ -3189,6 +3194,12 @@ static struct Lisp_Symbol *symbol_free_list; +static void +set_symbol_name (Lisp_Object sym, Lisp_Object name) +{ + XSYMBOL (sym)->name = name; +} + DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, doc: /* Return a newly allocated uninterned symbol whose name is NAME. Its value is void, and its function definition and property list are nil. */) === modified file 'src/buffer.c' --- src/buffer.c 2013-06-05 04:38:04 +0000 +++ src/buffer.c 2013-06-13 15:56:46 +0000 @@ -134,7 +134,7 @@ static Lisp_Object Qget_file_buffer; -Lisp_Object Qoverlayp; +static Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; @@ -150,6 +150,12 @@ static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); +static void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} + /* These setters are used only in this file, so they can be private. */ static void bset_abbrev_mode (struct buffer *b, Lisp_Object val) @@ -1539,7 +1545,7 @@ && BUFFER_LIVE_P (XBUFFER (b)) && !BUFFER_HIDDEN_P (XBUFFER (b))); } - + DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, doc: /* Return most recently selected buffer other than BUFFER. Buffers not visible in windows are preferred to visible buffers, unless === modified file 'src/chartab.c' --- src/chartab.c 2012-09-24 12:23:25 +0000 +++ src/chartab.c 2013-06-13 15:38:16 +0000 @@ -84,6 +84,22 @@ (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) +static void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} + +static void +set_char_table_ascii (Lisp_Object table, Lisp_Object val) +{ + XCHAR_TABLE (table)->ascii = val; +} +static void +set_char_table_parent (Lisp_Object table, Lisp_Object val) +{ + XCHAR_TABLE (table)->parent = val; +} \f DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, doc: /* Return a newly created char-table, with purpose PURPOSE. === modified file 'src/coding.c' --- src/coding.c 2013-05-22 14:53:21 +0000 +++ src/coding.c 2013-06-13 15:38:16 +0000 @@ -655,6 +655,22 @@ (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ } while (0) +static void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +static void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} + /* Safely get one byte from the source text pointed by SRC which ends at SRC_END, and set C to that byte. If there are not enough bytes === modified file 'src/data.c' --- src/data.c 2013-06-05 04:38:04 +0000 +++ src/data.c 2013-06-13 15:56:52 +0000 @@ -76,7 +76,7 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -Lisp_Object Qsubrp; +static Lisp_Object Qsubrp; static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; @@ -86,6 +86,94 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); +static bool +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +static bool +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +static bool +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} +static bool +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} + +static struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} +static struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} +static struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} +static struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +static void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} + +static void +set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) +{ + eassert (found == !EQ (blv->defcell, blv->valcell)); + blv->found = found; +} + +static Lisp_Object +blv_value (struct Lisp_Buffer_Local_Value *blv) +{ + return XCDR (blv->valcell); +} + +static void +set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + XSETCDR (blv->valcell, val); +} + +static void +set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->where = val; +} + +static void +set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->defcell = val; +} + +static void +set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->valcell = val; +} Lisp_Object wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) === modified file 'src/emacs.c' --- src/emacs.c 2013-06-05 12:17:02 +0000 +++ src/emacs.c 2013-06-13 15:38:16 +0000 @@ -306,6 +306,13 @@ static void *ns_pool; #endif +#if !HAVE_SETLOCALE +static char * +setlocale (int cat, char const *locale) +{ + return 0; +} +#endif /* Report a fatal error due to signal SIG, output a backtrace of at === modified file 'src/eval.c' --- src/eval.c 2013-06-05 04:38:04 +0000 +++ src/eval.c 2013-06-13 15:44:00 +0000 @@ -115,6 +115,69 @@ static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); +static Lisp_Object +specpdl_symbol (struct specbinding *pdl) +{ + eassert (pdl->kind >= SPECPDL_LET); + return pdl->v.let.symbol; +} + +static Lisp_Object +specpdl_old_value (struct specbinding *pdl) +{ + eassert (pdl->kind >= SPECPDL_LET); + return pdl->v.let.old_value; +} + +static Lisp_Object +specpdl_where (struct specbinding *pdl) +{ + eassert (pdl->kind > SPECPDL_LET); + return pdl->v.let.where; +} + +static Lisp_Object +specpdl_arg (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->v.unwind.arg; +} + +static specbinding_func +specpdl_func (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->v.unwind.func; +} + +static Lisp_Object +backtrace_function (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.function; +} + +static ptrdiff_t +backtrace_nargs (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.nargs; +} + +static Lisp_Object * +backtrace_args (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.args; +} + +static bool +backtrace_debug_on_exit (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.debug_on_exit; +} + /* Functions to modify slots of backtrace records. */ static void === modified file 'src/floatfns.c' --- src/floatfns.c 2013-03-24 12:59:45 +0000 +++ src/floatfns.c 2013-06-13 15:38:16 +0000 @@ -41,6 +41,14 @@ # define isnan(x) ((x) != (x)) #endif +/* Check that X is a floating point number. */ + +static void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} + /* Extract a Lisp number as a `double', or signal an error. */ double === modified file 'src/fns.c' --- src/fns.c 2013-06-05 04:38:04 +0000 +++ src/fns.c 2013-06-13 16:00:53 +0000 @@ -91,6 +91,12 @@ /* Random data-structure functions. */ +static void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} + DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. @@ -3335,7 +3341,7 @@ /* Various symbols. */ -Lisp_Object Qhash_table_p; +static Lisp_Object Qhash_table_p; static Lisp_Object Qkey, Qvalue, Qeql; Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; @@ -3346,6 +3352,48 @@ Utilities ***********************************************************************/ +static void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} + +static void +set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) +{ + h->key_and_value = key_and_value; +} +static void +set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) +{ + h->next = next; +} +static void +set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->next, idx, val); +} +static void +set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) +{ + h->hash = hash; +} +static void +set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->hash, idx, val); +} +static void +set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) +{ + h->index = index; +} +static void +set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->index, idx, val); +} + /* If OBJ is a Lisp hash table, return a pointer to its struct Lisp_Hash_Table. Otherwise, signal an error. */ === modified file 'src/keymap.c' --- src/keymap.c 2013-06-05 01:58:43 +0000 +++ src/keymap.c 2013-06-13 15:38:16 +0000 @@ -106,6 +106,12 @@ Lisp_Object, Lisp_Object, bool, bool); static void silly_event_symbol_error (Lisp_Object); static Lisp_Object get_keyelt (Lisp_Object, bool); + +static void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} \f /* Keymap object support - constructors and predicates. */ === modified file 'src/lisp.h' --- src/lisp.h 2013-06-13 00:07:44 +0000 +++ src/lisp.h 2013-06-13 16:02:41 +0000 @@ -715,7 +715,6 @@ /* Defined in this file. */ union Lisp_Fwd; -LISP_INLINE bool BOOLFWDP (union Lisp_Fwd *); LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); LISP_INLINE bool BUFFERP (Lisp_Object); @@ -725,12 +724,9 @@ LISP_INLINE bool (FLOATP) (Lisp_Object); LISP_INLINE bool functionp (Lisp_Object); LISP_INLINE bool (INTEGERP) (Lisp_Object); -LISP_INLINE bool INTFWDP (union Lisp_Fwd *); -LISP_INLINE bool KBOARD_OBJFWDP (union Lisp_Fwd *); LISP_INLINE bool (MARKERP) (Lisp_Object); LISP_INLINE bool (MISCP) (Lisp_Object); LISP_INLINE bool (NILP) (Lisp_Object); -LISP_INLINE bool OBJFWDP (union Lisp_Fwd *); LISP_INLINE bool OVERLAYP (Lisp_Object); LISP_INLINE bool PROCESSP (Lisp_Object); LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); @@ -745,9 +741,6 @@ LISP_INLINE bool WINDOWP (Lisp_Object); LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); -/* Defined in buffer.c. */ -extern Lisp_Object Qoverlayp; - /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); @@ -756,7 +749,7 @@ /* Defined in data.c. */ extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; -extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp; extern Lisp_Object Qvector_or_char_table_p, Qwholenump; extern Lisp_Object Ffboundp (Lisp_Object); extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); @@ -767,9 +760,6 @@ /* Defined in eval.c. */ extern Lisp_Object Qautoload; -/* Defined in fns.c */ -extern Lisp_Object Qhash_table_p; - /* Defined in floatfns.c. */ extern double extract_float (Lisp_Object); @@ -777,7 +767,7 @@ extern Lisp_Object Qprocessp; /* Defined in window.c. */ -extern Lisp_Object Qwindowp, Qwindow_configuration_p; +extern Lisp_Object Qwindowp; /* Defined in xdisp.c. */ extern Lisp_Object Qimage; @@ -956,13 +946,6 @@ typedef struct interval *INTERVAL; -/* Complain if object is not string or buffer type. */ -LISP_INLINE void -CHECK_STRING_OR_BUFFER (Lisp_Object x) -{ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); -} - struct Lisp_Cons { /* Car of this cons cell. */ @@ -1677,11 +1660,6 @@ { return PSEUDOVECTORP (a, PVEC_HASH_TABLE); } -LISP_INLINE void -CHECK_HASH_TABLE (Lisp_Object x) -{ - return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); -} /* Value is the key part of entry IDX in hash table H. */ LISP_INLINE Lisp_Object @@ -2156,40 +2134,12 @@ return a->u_intfwd.type; } -LISP_INLINE struct Lisp_Intfwd * -XINTFWD (union Lisp_Fwd *a) -{ - eassert (INTFWDP (a)); - return &a->u_intfwd; -} - -LISP_INLINE struct Lisp_Boolfwd * -XBOOLFWD (union Lisp_Fwd *a) -{ - eassert (BOOLFWDP (a)); - return &a->u_boolfwd; -} - -LISP_INLINE struct Lisp_Objfwd * -XOBJFWD (union Lisp_Fwd *a) -{ - eassert (OBJFWDP (a)); - return &a->u_objfwd; -} - LISP_INLINE struct Lisp_Buffer_Objfwd * XBUFFER_OBJFWD (union Lisp_Fwd *a) { eassert (BUFFER_OBJFWDP (a)); return &a->u_buffer_objfwd; } - -LISP_INLINE struct Lisp_Kboard_Objfwd * -XKBOARD_OBJFWD (union Lisp_Fwd *a) -{ - eassert (KBOARD_OBJFWDP (a)); - return &a->u_kboard_objfwd; -} \f /* Lisp floating point type. */ struct Lisp_Float @@ -2207,12 +2157,6 @@ return XFLOAT (f)->u.data; } -LISP_INLINE void -XFLOAT_INIT (Lisp_Object f, double n) -{ - XFLOAT (f)->u.data = n; -} - /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on exceptions. Define IEEE_FLOATING_POINT if this host is one of the @@ -2392,30 +2336,10 @@ } LISP_INLINE bool -INTFWDP (union Lisp_Fwd *a) -{ - return XFWDTYPE (a) == Lisp_Fwd_Int; -} -LISP_INLINE bool -BOOLFWDP (union Lisp_Fwd *a) -{ - return XFWDTYPE (a) == Lisp_Fwd_Bool; -} -LISP_INLINE bool -OBJFWDP (union Lisp_Fwd *a) -{ - return XFWDTYPE (a) == Lisp_Fwd_Obj; -} -LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *a) { return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; } -LISP_INLINE bool -KBOARD_OBJFWDP (union Lisp_Fwd *a) -{ - return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; -} LISP_INLINE bool PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) @@ -2532,11 +2456,6 @@ lisp_h_CHECK_LIST_CONS (x, y); } LISP_INLINE void -CHECK_LIST_END (Lisp_Object x, Lisp_Object y) -{ - CHECK_TYPE (NILP (x), Qlistp, y); -} -LISP_INLINE void CHECK_STRING (Lisp_Object x) { CHECK_TYPE (STRINGP (x), Qstringp, x); @@ -2557,11 +2476,6 @@ lisp_h_CHECK_SYMBOL (x); } LISP_INLINE void -CHECK_CHAR_TABLE (Lisp_Object x) -{ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); -} -LISP_INLINE void CHECK_VECTOR (Lisp_Object x) { CHECK_TYPE (VECTORP (x), Qvectorp, x); @@ -2577,11 +2491,6 @@ CHECK_TYPE (ARRAYP (x), Qxxxp, x); } LISP_INLINE void -CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) -{ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); -} -LISP_INLINE void CHECK_BUFFER (Lisp_Object x) { CHECK_TYPE (BUFFERP (x), Qbufferp, x); @@ -2592,21 +2501,11 @@ CHECK_TYPE (WINDOWP (x), Qwindowp, x); } LISP_INLINE void -CHECK_WINDOW_CONFIGURATION (Lisp_Object x) -{ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); -} -LISP_INLINE void CHECK_PROCESS (Lisp_Object x) { CHECK_TYPE (PROCESSP (x), Qprocessp, x); } LISP_INLINE void -CHECK_SUBR (Lisp_Object x) -{ - CHECK_TYPE (SUBRP (x), Qsubrp, x); -} -LISP_INLINE void (CHECK_NUMBER) (Lisp_Object x) { lisp_h_CHECK_NUMBER (x); @@ -2636,12 +2535,6 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -LISP_INLINE void -CHECK_MARKER (Lisp_Object x) -{ - CHECK_TYPE (MARKERP (x), Qmarkerp, x); -} - #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) @@ -2653,11 +2546,6 @@ } LISP_INLINE void -CHECK_FLOAT (Lisp_Object x) -{ - CHECK_TYPE (FLOATP (x), Qfloatp, x); -} -LISP_INLINE void CHECK_NUMBER_OR_FLOAT (Lisp_Object x) { CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); @@ -2667,12 +2555,6 @@ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -LISP_INLINE void -CHECK_OVERLAY (Lisp_Object x) -{ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); -} - /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ LISP_INLINE void @@ -2690,22 +2572,6 @@ CHECK_NUMBER (tmp); XSETCDR (x, tmp); } - -LISP_INLINE void -CHECK_NATNUM_CAR (Lisp_Object x) -{ - Lisp_Object tmp = XCAR (x); - CHECK_NATNUM (tmp); - XSETCAR (x, tmp); -} - -LISP_INLINE void -CHECK_NATNUM_CDR (Lisp_Object x) -{ - Lisp_Object tmp = XCDR (x); - CHECK_NATNUM (tmp); - XSETCDR (x, tmp); -} \f /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2932,33 +2798,6 @@ } v; }; -LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) -{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } - -LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl) -{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; } - -LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl) -{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; } - -LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; } - -LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; } - -LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; } - -LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; } - -LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; } - -LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; } - extern struct specbinding *specpdl; extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; @@ -3301,12 +3140,6 @@ /* Functions to modify hash tables. */ LISP_INLINE void -set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) -{ - h->key_and_value = key_and_value; -} - -LISP_INLINE void set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { gc_aset (h->key_and_value, 2 * idx, val); @@ -3318,52 +3151,10 @@ gc_aset (h->key_and_value, 2 * idx + 1, val); } -LISP_INLINE void -set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) -{ - h->next = next; -} - -LISP_INLINE void -set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->next, idx, val); -} - -LISP_INLINE void -set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) -{ - h->hash = hash; -} - -LISP_INLINE void -set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->hash, idx, val); -} - -LISP_INLINE void -set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) -{ - h->index = index; -} - -LISP_INLINE void -set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->index, idx, val); -} - /* Use these functions to set Lisp_Object or pointer slots of struct Lisp_Symbol. */ LISP_INLINE void -set_symbol_name (Lisp_Object sym, Lisp_Object name) -{ - XSYMBOL (sym)->name = name; -} - -LISP_INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { XSYMBOL (sym)->function = function; @@ -3390,43 +3181,6 @@ return blv->found; } -LISP_INLINE void -set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) -{ - eassert (found == !EQ (blv->defcell, blv->valcell)); - blv->found = found; -} - -LISP_INLINE Lisp_Object -blv_value (struct Lisp_Buffer_Local_Value *blv) -{ - return XCDR (blv->valcell); -} - -LISP_INLINE void -set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - XSETCDR (blv->valcell, val); -} - -LISP_INLINE void -set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->where = val; -} - -LISP_INLINE void -set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->defcell = val; -} - -LISP_INLINE void -set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->valcell = val; -} - /* Set overlay's property list. */ LISP_INLINE void @@ -3455,21 +3209,11 @@ of setting slots directly. */ LISP_INLINE void -set_char_table_ascii (Lisp_Object table, Lisp_Object val) -{ - XCHAR_TABLE (table)->ascii = val; -} -LISP_INLINE void set_char_table_defalt (Lisp_Object table, Lisp_Object val) { XCHAR_TABLE (table)->defalt = val; } LISP_INLINE void -set_char_table_parent (Lisp_Object table, Lisp_Object val) -{ - XCHAR_TABLE (table)->parent = val; -} -LISP_INLINE void set_char_table_purpose (Lisp_Object table, Lisp_Object val) { XCHAR_TABLE (table)->purpose = val; @@ -3525,7 +3269,6 @@ extern Lisp_Object Qbuffer, Qinteger, Qsymbol; -extern Lisp_Object Qsubrp; extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; @@ -4110,7 +3853,6 @@ extern Lisp_Object Vbuffer_alist; extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); -extern Lisp_Object Qoverlayp; extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); extern void init_buffer_once (void); @@ -4274,7 +4016,6 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -LISP_INLINE char *setlocale (int cat, char const *locale) { return 0; } LISP_INLINE void fixup_locale (void) {} LISP_INLINE void synchronize_system_messages_locale (void) {} LISP_INLINE void synchronize_system_time_locale (void) {} === modified file 'src/marker.c' --- src/marker.c 2013-02-19 14:44:03 +0000 +++ src/marker.c 2013-06-13 15:38:16 +0000 @@ -127,6 +127,12 @@ } \ } +static void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} + /* Return the byte position corresponding to CHARPOS in B. */ ptrdiff_t === modified file 'src/textprop.c' --- src/textprop.c 2013-03-28 14:04:49 +0000 +++ src/textprop.c 2013-06-13 15:38:16 +0000 @@ -98,6 +98,14 @@ set_buffer_internal (old); } +/* Complain if object is not string or buffer type. */ + +static void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} + /* Extract the interval at the position pointed to by BEGIN from OBJECT, a string or buffer. Additionally, check that the positions pointed to by BEGIN and END are within the bounds of OBJECT, and === modified file 'src/window.c' --- src/window.c 2013-06-05 04:38:04 +0000 +++ src/window.c 2013-06-13 16:02:24 +0000 @@ -55,7 +55,7 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_valid_p; -Lisp_Object Qwindow_configuration_p; +static Lisp_Object Qwindow_configuration_p; static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; @@ -131,6 +131,12 @@ static EMACS_INT window_scroll_preserve_hpos; static EMACS_INT window_scroll_preserve_vpos; \f +static void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} + /* These setters are used only in this file, so they can be private. */ static void wset_combination_limit (struct window *w, Lisp_Object val) ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-06 15:56 ` Paul Eggert 2013-06-06 16:36 ` Andreas Schwab @ 2013-06-06 16:42 ` Stefan Monnier 2013-06-09 0:52 ` Paul Eggert 1 sibling, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2013-06-06 16:42 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 > Attached is an updated version of this patch, > relative to the current trunk (bzr 112869). Having XCONS and friends duplicated into a macro version and a function version is a non-starter for me. Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-06 16:42 ` Stefan Monnier @ 2013-06-09 0:52 ` Paul Eggert 2013-06-09 3:04 ` Stefan Monnier 2013-06-09 6:56 ` Jan Djärv 0 siblings, 2 replies; 41+ messages in thread From: Paul Eggert @ 2013-06-09 0:52 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 On 06/06/13 09:42, Stefan Monnier wrote: > Having XCONS and friends duplicated into a macro version and a function > version is a non-starter for me. Yes, I didn't like those macros either. I'll remove them; they're no longer needed now that GCC has the -Og option. In case you haven't run into it yet, -Og means "optimize for debugging", and causes GCC to generate code that's easy to debug, without having the big runtime performance penalty of -O0. Like -O2 but unlike -O0, with -Og the CPU time for my little Lisp nthcdr benchmark is unaffected by the proposed patch (assuming those macros are removed). C compilation time is considerably faster for -Og than for -O2; it's not as fast as -O0, but for the common case of changing one C source file and then typing "make emacs", -Og is faster than -O0 (because bootstrap-emacs runs faster) and is a tad faster than -O2 (because the C compiler runs faster). Here are the detailed times, if you're curious. I got these on a Fedora 17 x86-64 (AMD Phenom II X4 910e) that was otherwise unloaded. I used plain 'make' without parallelism. Everything was built with GCC 4.8.1 and with Texinfo 5.1. All times are user+system CPU times; the low-order digits of the times aren't that reliable. (benchmark make \ rm fns.o; rm *.o; make \ 100000) xdisp.o make emacs make emacs bootstrap -O0 unpatched 2.89 3.1 12.4 57 1099 -O0 patched 21.66 3.0 20.0 63 2442 -Og unpatched 1.15 5.9 9.2 80 860 -Og patched 1.15 6.4 9.5 87 879 -O2 unpatched 1.57 11.3 9.6 110 843 -O2 patched 1.57 11.1 9.9 119 847 In (benchmark 100000) the -Og code runs faster than -O2, which is surprising, but I think it's an anomaly; I may find the time to fire off a performance bug-report to the GCC developers. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 0:52 ` Paul Eggert @ 2013-06-09 3:04 ` Stefan Monnier 2013-06-09 4:37 ` James Cloos 2013-06-09 7:13 ` Paul Eggert 2013-06-09 6:56 ` Jan Djärv 1 sibling, 2 replies; 41+ messages in thread From: Stefan Monnier @ 2013-06-09 3:04 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 >> Having XCONS and friends duplicated into a macro version and a function >> version is a non-starter for me. > Yes, I didn't like those macros either. I'll remove them; they're no > longer needed now that GCC has the -Og option. Sadly, I don't live in the same era as you do: my gcc doesn't take -Og yet. > -O0 unpatched 2.89 3.1 12.4 57 1099 > -O0 patched 21.66 3.0 20.0 63 2442 An almost 10 times slowdown for the -O0 case is really problematic. IOW I think it'll be a fine idea but only when -Og is supported in Debian stable. Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 3:04 ` Stefan Monnier @ 2013-06-09 4:37 ` James Cloos 2013-06-09 6:59 ` Jan Djärv 2013-06-09 7:13 ` Paul Eggert 1 sibling, 1 reply; 41+ messages in thread From: James Cloos @ 2013-06-09 4:37 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935, Paul Eggert >>>>> "SM" == Stefan Monnier <monnier@iro.umontreal.ca> writes: SM> An almost 10 times slowdown for the -O0 case is really problematic. SM> IOW I think it'll be a fine idea but only when -Og is supported in SM> Debian stable. Jessie has gcc-4.8, so that is just one more freeze/thaw cycle. However long that takes. :^) -JimC -- James Cloos <cloos@jhcloos.com> OpenPGP: 1024D/ED7DAEA6 ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 4:37 ` James Cloos @ 2013-06-09 6:59 ` Jan Djärv 0 siblings, 0 replies; 41+ messages in thread From: Jan Djärv @ 2013-06-09 6:59 UTC (permalink / raw) To: James Cloos; +Cc: 11935, Paul Eggert 9 jun 2013 kl. 06:37 skrev James Cloos <cloos@jhcloos.com>: >>>>>> "SM" == Stefan Monnier <monnier@iro.umontreal.ca> writes: > > SM> An almost 10 times slowdown for the -O0 case is really problematic. > SM> IOW I think it'll be a fine idea but only when -Og is supported in > SM> Debian stable. > > Jessie has gcc-4.8, so that is just one more freeze/thaw cycle. > > However long that takes. :^) Some distibutions will never get gcc 4.8. Not everybody upgrades to the latest version. I think it would be a big mistake to introduce a x10 slowdown for pre 4.8 gcc users. Jan D. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 3:04 ` Stefan Monnier 2013-06-09 4:37 ` James Cloos @ 2013-06-09 7:13 ` Paul Eggert 2013-06-09 15:57 ` Stefan Monnier 1 sibling, 1 reply; 41+ messages in thread From: Paul Eggert @ 2013-06-09 7:13 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 On 06/08/2013 08:04 PM, Stefan Monnier wrote: > I think it'll be a fine idea but only when -Og is supported in > Debian stable. I'd rather not wait three (or five!) more years to install helpful changes like this. I might not live that long. If it's unacceptable to maintain both a macro and a function implementation for a few primitives, we can simply have the latter invoke the former -- that way, there's only one actual implementation. Or if you prefer, we can omit the functions entirely. We can leave in a FIXME reminding us to change the macros to functions after the three years or so. Another option is that you could download and install GCC 4.8.x on your Debian stable host. That should work. That might be better for Emacs development, though it'd be a bit more of an effort for you. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 7:13 ` Paul Eggert @ 2013-06-09 15:57 ` Stefan Monnier 2013-06-13 14:45 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2013-06-09 15:57 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 >> I think it'll be a fine idea but only when -Og is supported in >> Debian stable. > I'd rather not wait three (or five!) more years to install helpful > changes like this. I might not live that long. OTOH we've been using the current macros for so many years that the change is not exactly urgent. > If it's unacceptable to maintain both a macro and a function > implementation for a few primitives, we can simply have the > latter invoke the former -- that way, there's only one actual > implementation. I could live with that. > Or if you prefer, we can omit the functions entirely. Sounds even better. > We can leave in a FIXME reminding us to > change the macros to functions after the three years or so. Sure. > Another option is that you could download and install > GCC 4.8.x on your Debian stable host. I'm running Debian testing on most of my machines, so it should get to 4.8 pretty soon, but as others have pointed out, Debian is not the only problem. I generally take "Debian stable" as a reference, not because I use Debian but because it seems that if something is in Debian stable you can mostly assume it's also available in most other contexts. Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 15:57 ` Stefan Monnier @ 2013-06-13 14:45 ` Paul Eggert 2013-06-13 20:08 ` Stefan Monnier 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2013-06-13 14:45 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 [-- Attachment #1: Type: text/plain, Size: 2050 bytes --] On 06/09/13 08:57, Stefan Monnier wrote: >> > If it's unacceptable to maintain both a macro and a function >> > implementation for a few primitives, we can simply have the >> > latter invoke the former -- that way, there's only one actual >> > implementation. > I could live with that. OK, attached is a patch to do that. I think this is a bit better than a macro-only implementation as it makes the way forward clearer for a few years from now, when we can assume GCC 4.8 or later. This fixes the -O0 performance problem, so developers using pre-4.8 GCC (or clang) won't suffer. Here are the measurements, where "old patch" refers to the previous version of the patch with the XINT etc. macros removed, and "new patch" refers to the attached. The benchmark is the same as before. As before, the low-order digits probably aren't that significant. Fedora 17 x86-64, AMD Phenom II X4 910e Clang 3.0 (Fedora 17) GCC 4.8.1 (I built it) single-process make (no -j) (benchmark make \ rm fns.o; rm *.o; make \ 100000) xdisp.o make emacs make emacs bootstrap GCC -O2 unpatched 1.57 11.3 9.6 110 843 GCC -O2 old patch 1.57 11.1 9.9 119 847 GCC -O2 new patch 1.38 10.9 9.9 118 850 GCC -Og unpatched 1.15 5.9 9.2 80 860 GCC -Og old patch 1.15 6.4 9.5 87 879 GCC -Og new patch 1.15 6.4 9.5 86 874 GCC -O0 unpatched 2.89 3.1 12.4 57 1099 GCC -O0 old patch 21.66 3.0 20.0 63 2442 GCC -O0 new patch 2.89 2.9 13.2 56 1265 Clang -O2 unpatched 1.57 6.3 8.3 65 818 Clang -O2 old patch 1.34 6.8 8.5 70 826 Clang -O2 new patch 1.34 6.8 8.5 70 830 Clang -O0 unpatched 3.72 1.5 10.9 34 1159 Clang -O0 old patch 17.89 1.4 17.0 39 2309 Clang -O0 new patch 3.92 1.4 11.8 34 1332 [-- Attachment #2: inline4n.txt --] [-- Type: text/plain, Size: 79441 bytes --] === modified file 'ChangeLog' --- ChangeLog 2013-06-11 18:05:05 +0000 +++ ChangeLog 2013-06-13 14:17:01 +0000 @@ -1,3 +1,9 @@ +2013-06-13 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + 2013-06-11 Paul Eggert <eggert@cs.ucla.edu> --without-all should imply --with-file-notification=no. (Bug#14569) === modified file 'configure.ac' --- configure.ac 2013-06-13 06:28:05 +0000 +++ configure.ac 2013-06-13 14:17:01 +0000 @@ -776,6 +776,7 @@ # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-13 05:13:05 +0000 +++ src/ChangeLog 2013-06-13 14:17:01 +0000 @@ -1,3 +1,128 @@ +2013-06-13 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + In lisp.h, prefer functions to function-like macros, and + constants to object-like macros, when either will do. This: + . simplifies use, as there's no more need to worry about + arguments' side effects being evaluated multiple times. + . makes the code easier to debug on some platforms. + However, when using gcc -O0, keep using function-like macros + for a few critical operations, for performance reasons. + This sort of thing isn't needed with gcc -Og, but -Og + is a GCC 4.8 feature and isn't widely-enough available yet. + * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: + Remove enum lsb_bits; no longer needed. + (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue. + * buffer.c (Qoverlap): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + Now extern, so lisp.h can use these symbols. + * dispextern.h: Include character.h, for MAX_CHAR etc. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move here from lisp.h. + (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. + (GLYPH_MODE_LINE_FACE): Now enums, not macros. + * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since + XUNTAG now returns void *. + * lisp.h (lisp_h_XLI, lisp_h_XIL, lisp_h_CHECK_LIST_CONS) + (lisp_h_CHECK_NUMBER CHECK_SYMBOL, lisp_h_CHECK_TYPE) + (lisp_h_CONSP, lisp_h_EQ, lisp_h_FLOATP, lisp_h_INTEGERP) + (lisp_h_LISP_INT_TAG_P, lisp_h_MARKERP, lisp_h_MISCP, lisp_h_NILP) + (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_CONSTANT_P) + (lisp_h_SYMBOL_VAL, lisp_h_SYMBOLP, lisp_h_VECTORLIKEP) + (lisp_h_XCAR, lisp_h_XCDR, lisp_h_XCONS, lisp_h_XHASH) + (lisp_h_XPNTR, lisp_h_XSYMBOL): + New macros, renamed from their sans-lisp_h_ counterparts. + (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL) + (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, LISP_INT_TAG_P, MARKERP) + (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) + (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): + If compiling via GCC without optimization, define these as macros + in addition to inline functions. + To disable this, compile with -DINLINING=0. + (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise. + (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but + hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. + (INTMASK, VALMASK): Now macros, since static values cannot be + accessed from extern inline functions. + (VALMASK): Also a constant, for benefit of old GDB. + (LISP_INT_TAG_P, XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) + (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) + (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) + (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) + (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) + (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET) + (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF) + (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) + (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS) + (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) + (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) + (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) + (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE) + (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE) + (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE) + (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) + (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) + (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) + (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) + (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP) + (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP) + (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) + (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) + (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) + (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) + (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) + (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) + (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) + (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) + (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) + (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) + (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) + Now functions. + (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. + (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed. + (VALMASK): Define in one place rather than in two, merging the + USE_LSB_TAG parts; this is simpler. + (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM) + (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): + Move up, to avoid use before definition. + Also include "globals.h" earlier, for the same reason. + (make_natnum): New function. + (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. + (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) + (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) + (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) + (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) + (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) + (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) + (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) + (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) + (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) + (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) + (Qwindow_configuration_p, Qimage): New forward declarations. + (XSETFASTINT): Simplify by rewriting in terms of make_natnum. + (STRING_COPYIN): Remove; unused. + (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ... + (xcar_addr, xcdr_addr): New functions. All uses changed. + (IEEE_FLOATING_POINT): Now a constant, not a macro. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. + (TYPE_RANGED_INTEGERP): Simplify. + (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. + (setlocale, fixup_locale, synchronize_system_messages_locale) + (synchronize_system_time_locale) [!HAVE_SETLOCALE]: + Now empty functions, not macros. + (functionp): Return bool, not int. + * window.c (Qwindow_configuration_p): Now extern, + so window.h can use it. + * window.h (Qwindowp): Move decl back to lisp.h. + 2013-06-13 Kelly Dean <kellydeanch@yahoo.com> (tiny change) * fileio.c (Fdo_auto_save): Trap errors in auto-save-hook. (Bug#14479) === modified file 'src/alloc.c' --- src/alloc.c 2013-06-03 09:01:53 +0000 +++ src/alloc.c 2013-06-09 19:42:53 +0000 @@ -3309,7 +3309,7 @@ --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; - XMISCTYPE (val) = type; + XMISCANY (val)->type = type; XMISCANY (val)->gcmarkbit = 0; return val; } @@ -3319,7 +3319,7 @@ void free_misc (Lisp_Object misc) { - XMISCTYPE (misc) = Lisp_Misc_Free; + XMISCANY (misc)->type = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); consing_since_gc -= sizeof (union Lisp_Misc); @@ -5647,7 +5647,7 @@ { CONS_MARK (XCONS (tail)); mark_object (XCAR (tail)); - prev = &XCDR_AS_LVALUE (tail); + prev = xcdr_addr (tail); } } mark_object (tail); @@ -6689,8 +6689,5 @@ enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; -#if USE_LSB_TAG - enum lsb_bits lsb_bits; -#endif } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ === modified file 'src/buffer.c' --- src/buffer.c 2013-05-07 14:12:57 +0000 +++ src/buffer.c 2013-06-09 19:42:53 +0000 @@ -134,7 +134,7 @@ static Lisp_Object Qget_file_buffer; -static Lisp_Object Qoverlayp; +Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; === modified file 'src/data.c' --- src/data.c 2013-06-03 18:29:30 +0000 +++ src/data.c 2013-06-12 23:41:54 +0000 @@ -76,7 +76,8 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -static Lisp_Object Qsubrp, Qmany, Qunevalled; +Lisp_Object Qsubrp; +static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; === modified file 'src/dispextern.h' --- src/dispextern.h 2013-06-08 18:28:36 +0000 +++ src/dispextern.h 2013-06-09 19:42:53 +0000 @@ -22,6 +22,8 @@ #ifndef DISPEXTERN_H_INCLUDED #define DISPEXTERN_H_INCLUDED +#include "character.h" + #ifdef HAVE_X_WINDOWS #include <X11/Xlib.h> @@ -270,6 +272,55 @@ Glyphs ***********************************************************************/ +/* The glyph datatype, used to represent characters on the display. + It consists of a char code and a face id. */ + +typedef struct { + int ch; + int face_id; +} GLYPH; + +/* Return a glyph's character code. */ +DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } + +/* Return a glyph's face ID. */ +DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } + +#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) +#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) +#define SET_GLYPH(glyph, char, face) \ + ((glyph).ch = (char), (glyph).face_id = (face)) + +/* The following are valid only if GLYPH_CODE_P (gc). */ + +DISPEXTERN_INLINE int +GLYPH_CODE_CHAR (Lisp_Object gc) +{ + return (CONSP (gc) + ? XINT (XCAR (gc)) + : XINT (gc) & MAX_CHAR); +} + +DISPEXTERN_INLINE int +GLYPH_CODE_FACE (Lisp_Object gc) +{ + return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; +} + +#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ + do \ + { \ + if (CONSP (gc)) \ + SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + else \ + SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ + (XINT (gc) >> CHARACTERBITS)); \ + } \ + while (0) + +/* The ID of the mode line highlighting face. */ +enum { GLYPH_MODE_LINE_FACE = 1 }; + /* Enumeration of glyph types. Glyph structures contain a type field containing one of the enumerators defined here. */ @@ -1774,6 +1825,30 @@ #endif /* not HAVE_WINDOW_SYSTEM */ +/* Return true if G contains a valid character code. */ +DISPEXTERN_INLINE bool +GLYPH_CHAR_VALID_P (GLYPH g) +{ + return CHAR_VALID_P (GLYPH_CHAR (g)); +} + +/* The glyph code from a display vector may either be an integer which + encodes a char code in the lower CHARACTERBITS bits and a (very small) + face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ + +DISPEXTERN_INLINE bool +GLYPH_CODE_P (Lisp_Object gc) +{ + return (CONSP (gc) + ? (CHARACTERP (XCAR (gc)) + && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_INTEGERP + (0, gc, + (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR + : TYPE_MAXIMUM (EMACS_INT))))); +} + /* Non-zero means face attributes have been changed since the last redisplay. Used in redisplay_internal. */ === modified file 'src/fns.c' --- src/fns.c 2013-04-08 18:04:58 +0000 +++ src/fns.c 2013-06-12 23:42:10 +0000 @@ -3335,7 +3335,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; +Lisp_Object Qhash_table_p; +static Lisp_Object Qkey, Qvalue, Qeql; Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; === modified file 'src/lisp.h' --- src/lisp.h 2013-06-05 12:17:02 +0000 +++ src/lisp.h 2013-06-13 00:06:53 +0000 @@ -220,6 +220,130 @@ #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. + There's no need to inline everything, just the operations that + would otherwise cause a serious performance problem. + + For each such operation OP, define a macro lisp_h_OP that contains + the operation's implementation. That way, OP can be implementated + via a macro definition like this: + + #define OP(x) lisp_h_OP (x) + + and/or via a function definition like this: + + Lisp_Object + (OP) (Lisp_Object x) + { + return lisp_h_OP (x); + } + + without worrying about the implementations diverging, since + lisp_h_OP defines the actual implementation. The lisp_h_OP macros + are intended to be private to this include file, and should not be + used elsewhere. + + FIXME: Remove the lisp_h_OP macros, and define just the inline OP + functions, once most developers have access to GCC 4.8 or later and + can use "gcc -Og" to debug. Maybe in the year 2016. See + Bug#11935. + + 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 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) \ + ((void) ((ok) || 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) LISP_INT_TAG_P (XTYPE (x)) +#define lisp_h_LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) +#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_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) | DATA_SEG_BITS)) +#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) (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=0. */ +#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 LISP_INT_TAG_P(x) lisp_h_LISP_INT_TAG_P (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 the fundamental Lisp data structures. */ /* This is the set of Lisp data types. If you want to define a new @@ -230,7 +354,6 @@ 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 LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, and xlc complains vociferously about them. */ @@ -270,6 +393,12 @@ Lisp_Float = 7, }; +LISP_INLINE bool +(LISP_INT_TAG_P) (int x) +{ + return lisp_h_LISP_INT_TAG_P (x); +} + /* This is the set of data types that share a common structure. The first member of the structure is a type code from this set. The enum values are arbitrary, but we'll use large numbers to make it @@ -359,20 +488,6 @@ typedef struct { EMACS_INT i; } Lisp_Object; -#define XLI(o) (o).i -LISP_INLINE Lisp_Object -XIL (EMACS_INT i) -{ - Lisp_Object o = { i }; - return o; -} - -LISP_INLINE Lisp_Object -LISP_MAKE_RVALUE (Lisp_Object o) -{ - return o; -} - #define LISP_INITIALLY_ZERO {0} #undef CHECK_LISP_OBJECT_TYPE @@ -382,13 +497,22 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -#define XLI(o) (o) -#define XIL(i) (i) -#define LISP_MAKE_RVALUE(o) (0 + (o)) #define LISP_INITIALLY_ZERO 0 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; #endif /* CHECK_LISP_OBJECT_TYPE */ +LISP_INLINE EMACS_INT +(XLI) (Lisp_Object o) +{ + return lisp_h_XLI (o); +} + +LISP_INLINE Lisp_Object +(XIL) (EMACS_INT i) +{ + return lisp_h_XIL (i); +} + /* In the size word of a vector, this bit means the vector has been marked. */ static ptrdiff_t const ARRAY_MARK_FLAG @@ -460,84 +584,119 @@ BOOL_VECTOR_BITS_PER_CHAR = 8 }; \f -/* These macros extract various sorts of values from a Lisp_Object. +/* These functions extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -#if USE_LSB_TAG - -enum lsb_bits - { - TYPEMASK = (1 << GCTYPEBITS) - 1, - VALMASK = ~ TYPEMASK - }; -#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) -#define XINT(a) (XLI (a) >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) -#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) -#define make_lisp_ptr(ptr, type) \ - (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ - XIL ((type) | (intptr_t) (ptr))) - -#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) -#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) - -#else /* not USE_LSB_TAG */ - static EMACS_INT const VALMASK -#define VALMASK VAL_MAX +#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) = VALMASK; -#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp integers have zero-bits in their tags. */ -#define XFASTINT(a) (XLI (a) + 0) -#define XSETFASTINT(a, b) ((a) = XIL (b)) - -/* Extract the value of a Lisp_Object as a (un)signed integer. */ - -#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) -#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) - -#define make_lisp_ptr(ptr, type) \ - (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object. */ -#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) - -#endif /* not USE_LSB_TAG */ +/* 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) + +LISP_INLINE enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XTYPE (a); +#else + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; +#endif +} + +/* Extract the value of a Lisp_Object as a signed integer. */ +LISP_INLINE EMACS_INT +(XINT) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XINT (a); +#else + EMACS_INT i = XLI (a); + return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; +#endif +} + +/* Like XINT (A), but may be faster. A must be nonnegative. This takes + advantage of the fact that Lisp integers have zero-bits in their tags. */ +LISP_INLINE EMACS_INT +(XFASTINT) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XFASTINT (a); +#else + EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a); + eassert (0 <= n); + return n; +#endif +} + +/* Extract the value of a Lisp_Object as an unsigned integer. */ +LISP_INLINE EMACS_UINT +XUINT (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; +} /* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be like XUINT right now, but XUINT should only be applied to objects we know are integers. */ -#define XHASH(a) XUINT (a) +LISP_INLINE EMACS_INT +(XHASH) (Lisp_Object a) +{ + return lisp_h_XHASH (a); +} -/* For integers known to be positive, XFASTINT sometimes provides - faster retrieval and XSETFASTINT provides faster storage. - If not, fallback on the non-accelerated path. */ -#ifndef XFASTINT -# define XFASTINT(a) (XINT (a)) -# define XSETFASTINT(a, b) (XSETINT (a, b)) +LISP_INLINE Lisp_Object +(make_number) (EMACS_INT n) +{ +#if USE_LSB_TAG + return lisp_h_make_number (n); +#else + return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); #endif +} + +/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +LISP_INLINE Lisp_Object +make_natnum (EMACS_INT n) +{ + eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); + return USE_LSB_TAG ? make_number (n) : XIL (n); +} + +LISP_INLINE void * +(XPNTR) (Lisp_Object a) +{ + return lisp_h_XPNTR (a); +} /* Extract the pointer value of the Lisp object A, under the - assumption that A's type is TYPE. This is a fallback - implementation if nothing faster is available. */ -#ifndef XUNTAG -# define XUNTAG(a, type) XPNTR (a) + assumption that A's type is TYPE. */ +LISP_INLINE void * +(XUNTAG) (Lisp_Object a, int type) +{ +#if USE_LSB_TAG + return lisp_h_XUNTAG (a, type); +#else + if (USE_LSB_TAG) + { + intptr_t i = XLI (a) - type; + return (void *) i; + } + return XPNTR (a); #endif - -#define EQ(x, y) (XLI (x) == XLI (y)) - -/* 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) +} + +LISP_INLINE bool +(EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_EQ (x, y); +} /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned @@ -551,66 +710,191 @@ { return num < lower ? lower : num <= upper ? num : upper; } - -\f +\f +/* Forward declarations. */ + +/* Defined in this file. */ +union Lisp_Fwd; +LISP_INLINE bool BOOLFWDP (union Lisp_Fwd *); +LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); +LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool BUFFERP (Lisp_Object); +LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); +LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); +LISP_INLINE bool (CONSP) (Lisp_Object); +LISP_INLINE bool (FLOATP) (Lisp_Object); +LISP_INLINE bool functionp (Lisp_Object); +LISP_INLINE bool (INTEGERP) (Lisp_Object); +LISP_INLINE bool INTFWDP (union Lisp_Fwd *); +LISP_INLINE bool KBOARD_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool (MARKERP) (Lisp_Object); +LISP_INLINE bool (MISCP) (Lisp_Object); +LISP_INLINE bool (NILP) (Lisp_Object); +LISP_INLINE bool OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool OVERLAYP (Lisp_Object); +LISP_INLINE bool PROCESSP (Lisp_Object); +LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); +LISP_INLINE bool SAVE_VALUEP (Lisp_Object); +LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, + Lisp_Object); +LISP_INLINE bool STRINGP (Lisp_Object); +LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); +LISP_INLINE bool SUBRP (Lisp_Object); +LISP_INLINE bool (SYMBOLP) (Lisp_Object); +LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); +LISP_INLINE bool WINDOWP (Lisp_Object); +LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + +/* Defined in buffer.c. */ +extern Lisp_Object Qoverlayp; + +/* Defined in chartab.c. */ +extern Lisp_Object char_table_ref (Lisp_Object, int); +extern void char_table_set (Lisp_Object, int, Lisp_Object); +extern int char_table_translate (Lisp_Object, int); + +/* Defined in data.c. */ +extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; +extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; +extern Lisp_Object Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qvector_or_char_table_p, Qwholenump; +extern Lisp_Object Ffboundp (Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + +/* Defined in emacs.c. */ +extern bool initialized; + +/* Defined in eval.c. */ +extern Lisp_Object Qautoload; + +/* Defined in fns.c */ +extern Lisp_Object Qhash_table_p; + +/* Defined in floatfns.c. */ +extern double extract_float (Lisp_Object); + +/* Defined in process.c. */ +extern Lisp_Object Qprocessp; + +/* Defined in window.c. */ +extern Lisp_Object Qwindowp, Qwindow_configuration_p; + +/* Defined in xdisp.c. */ +extern Lisp_Object Qimage; +\f + /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) -#define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) - -/* Misc types. */ - -#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) -#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) -#define XMISCTYPE(a) (XMISCANY (a)->type) -#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) -#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) - -/* Forwarding object types. */ - -#define XFWDTYPE(a) (a->u_intfwd.type) -#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) -#define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) -#define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) +LISP_INLINE struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + return lisp_h_XCONS (a); +} + +LISP_INLINE struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + +LISP_INLINE struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ + return lisp_h_XSYMBOL (a); +} + +LISP_INLINE struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} /* Pseudovector types. */ -struct Lisp_Process; -LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) -{ return make_lisp_ptr (p, Lisp_Vectorlike); } -#define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) -#define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ - ((struct Lisp_Bool_Vector *) \ - XUNTAG (a, Lisp_Vectorlike))) + +LISP_INLINE struct Lisp_Process * +XPROCESS (Lisp_Object a) +{ + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct window * +XWINDOW (Lisp_Object a) +{ + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct terminal * +XTERMINAL (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct buffer * +XBUFFER (Lisp_Object a) +{ + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Sub_Char_Table * +XSUB_CHAR_TABLE (Lisp_Object a) +{ + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_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. */ +LISP_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; +} + +LISP_INLINE Lisp_Object +make_lisp_proc (struct Lisp_Process *p) +{ + return make_lisp_ptr (p, Lisp_Vectorlike); +} + #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)) @@ -656,35 +940,13 @@ #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -/* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -#define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) - -/* Convenience macros for dealing with Lisp strings. */ - -#define SDATA(string) (XSTRING (string)->data + 0) -#define SREF(string, index) (SDATA (string)[index] + 0) -#define SSET(string, index, new) (SDATA (string)[index] = (new)) -#define SCHARS(string) (XSTRING (string)->size + 0) -#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - -/* Avoid "differ in sign" warnings. */ -#define SSDATA(x) ((char *) SDATA (x)) - -#define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - -#define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ -#define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) +LISP_INLINE void +(CHECK_TYPE) (int ok, Lisp_Object Qxxxp, Lisp_Object x) +{ + lisp_h_CHECK_TYPE (ok, Qxxxp, x); +} /* Deprecated and will be removed soon. */ @@ -695,8 +957,11 @@ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type. */ -#define CHECK_STRING_OR_BUFFER(x) \ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) +LISP_INLINE void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} struct Lisp_Cons { @@ -714,64 +979,94 @@ }; /* Take the car or cdr of something known to be a cons cell. */ -/* The _AS_LVALUE macros shouldn't be used outside of the minimal set +/* 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 as lvalues. (What if we want to switch to + 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.) */ -#define XCAR_AS_LVALUE(c) (XCONS (c)->car) -#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) +LISP_INLINE Lisp_Object * +xcar_addr (Lisp_Object c) +{ + return &XCONS (c)->car; +} +LISP_INLINE Lisp_Object * +xcdr_addr (Lisp_Object c) +{ + return &XCONS (c)->u.cdr; +} /* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) +LISP_INLINE Lisp_Object +(XCAR) (Lisp_Object c) +{ + return lisp_h_XCAR (c); +} +LISP_INLINE Lisp_Object +(XCDR) (Lisp_Object c) +{ + return lisp_h_XCDR (c); +} /* Use these to set the fields of a cons cell. Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR(c) \ - (CONSP ((c)) ? XCAR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -#define CDR(c) \ - (CONSP ((c)) ? XCDR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR_SAFE(c) \ - (CONSP ((c)) ? XCAR ((c)) : Qnil) - -#define CDR_SAFE(c) \ - (CONSP ((c)) ? XCDR ((c)) : Qnil) + should not be read after 'c' is first modified. */ +LISP_INLINE void +XSETCAR (Lisp_Object c, Lisp_Object n) +{ + *xcar_addr (c) = n; +} +LISP_INLINE void +XSETCDR (Lisp_Object c, Lisp_Object n) +{ + *xcdr_addr (c) = n; +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR (Lisp_Object c) +{ + return (CONSP (c) ? XCAR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} +LISP_INLINE Lisp_Object +CDR (Lisp_Object c) +{ + return (CONSP (c) ? XCDR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCAR (c) : Qnil; +} +LISP_INLINE Lisp_Object +CDR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCDR (c) : Qnil; +} + +/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; /* True if STR is a multibyte string. */ -#define STRING_MULTIBYTE(STR) \ - (XSTRING (STR)->size_byte >= 0) - -/* Return the length in bytes of STR. */ - -#ifdef GC_CHECK_STRING_BYTES - -struct Lisp_String; -extern ptrdiff_t string_bytes (struct Lisp_String *); -#define STRING_BYTES(S) string_bytes ((S)) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define STRING_BYTES(STR) \ - ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) - -#endif /* not GC_CHECK_STRING_BYTES */ +LISP_INLINE bool +STRING_MULTIBYTE (Lisp_Object str) +{ + return 0 <= XSTRING (str)->size_byte; +} /* An upper bound on the number of bytes in a Lisp string, not counting the terminating null. This a tight enough bound to @@ -802,20 +1097,65 @@ (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ +/* Convenience functions for dealing with Lisp strings. */ -struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; +LISP_INLINE unsigned char * +SDATA (Lisp_Object string) +{ + return XSTRING (string)->data; +} +LISP_INLINE char * +SSDATA (Lisp_Object string) +{ + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); +} +LISP_INLINE unsigned char +SREF (Lisp_Object string, ptrdiff_t index) +{ + return SDATA (string)[index]; +} +LISP_INLINE void +SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) +{ + SDATA (string)[index] = new; +} +LISP_INLINE ptrdiff_t +SCHARS (Lisp_Object string) +{ + return XSTRING (string)->size; +} +LISP_INLINE ptrdiff_t +STRING_BYTES (struct Lisp_String *s) +{ +#ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + return string_bytes (s); +#else + return s->size_byte < 0 ? s->size : s->size_byte; +#endif +} +LISP_INLINE ptrdiff_t +SBYTES (Lisp_Object string) +{ + return STRING_BYTES (XSTRING (string)); +} +LISP_INLINE void +STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) +{ + XSTRING (string)->size = newsize; +} +LISP_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 - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ @@ -874,6 +1214,42 @@ word_size = sizeof (Lisp_Object) }; +/* Conveniences for dealing with Lisp arrays. */ + +LISP_INLINE Lisp_Object +AREF (Lisp_Object array, ptrdiff_t idx) +{ + return XVECTOR (array)->contents[idx]; +} + +LISP_INLINE Lisp_Object * +aref_addr (Lisp_Object array, ptrdiff_t idx) +{ + return & XVECTOR (array)->contents[idx]; +} + +LISP_INLINE ptrdiff_t +ASIZE (Lisp_Object array) +{ + return XVECTOR (array)->header.size; +} + +LISP_INLINE void +ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + eassert (0 <= idx && idx < ASIZE (array)); + XVECTOR (array)->contents[idx] = val; +} + +LISP_INLINE void +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)); + XVECTOR (array)->contents[idx] = val; +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ @@ -887,43 +1263,6 @@ #define PSEUDOVECSIZE(type, nonlispfield) \ ((offsetof (type, nonlispfield) - header_size) / word_size) -/* A char-table is a kind of vectorlike, with contents are like a - vector but with a few other slots. For some purposes, it makes - sense to handle a char-table with type struct Lisp_Vector. An - element of a char table can be any Lisp objects, but if it is a sub - char-table, we treat it a table that contains information of a - specific range of characters. A sub char-table has the same - structure as a vector. A sub char table appears only in an element - of a char-table, and there's no way to access it directly from - Emacs Lisp program. */ - -#ifdef __GNUC__ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - ({struct Lisp_Char_Table *_tbl = NULL; \ - Lisp_Object _val; \ - do { \ - _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ - _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ - : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ - if (NILP (_val)) \ - _val = _tbl->defalt; \ - } while (NILP (_val) && ! NILP (_tbl->parent)); \ - _val; }) - -#else /* not __GNUC__ */ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - (! NILP (XCHAR_TABLE (CT)->ascii) \ - ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XCHAR_TABLE (CT)->ascii \ - : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ - : char_table_ref ((CT), (IDX))) \ - : char_table_ref ((CT), (IDX))) - -#endif /* not __GNUC__ */ - /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) @@ -937,18 +1276,15 @@ /* Nonzero iff C is an ASCII character. */ #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - characters. Do not check validity of CT. */ -#define CHAR_TABLE_REF(CT, IDX) \ - (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ - : char_table_ref ((CT), (IDX))) - -/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit European characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \ - : char_table_set (CT, IDX, VAL)) +/* A char-table is a kind of vectorlike, with contents are like a + vector but with a few other slots. For some purposes, it makes + sense to handle a char-table with type struct Lisp_Vector. An + element of a char table can be any Lisp objects, but if it is a sub + char-table, we treat it a table that contains information of a + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ enum CHARTAB_SIZE_BITS { @@ -1012,6 +1348,45 @@ Lisp_Object contents[1]; }; +LISP_INLINE Lisp_Object +CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) +{ + struct Lisp_Char_Table *tbl = NULL; + Lisp_Object val; + do + { + tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); + val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii + : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + if (NILP (val)) + val = tbl->defalt; + } + while (NILP (val) && ! NILP (tbl->parent)); + + return val; +} + +/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII + characters. Do not check validity of CT. */ +LISP_INLINE Lisp_Object +CHAR_TABLE_REF (Lisp_Object ct, int idx) +{ + return (ASCII_CHAR_P (idx) + ? CHAR_TABLE_REF_ASCII (ct, idx) + : char_table_ref (ct, idx)); +} + +/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and + 8-bit European characters. Do not check validity of CT. */ +LISP_INLINE void +CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) +{ + if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) + set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val); + else + 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. */ @@ -1048,8 +1423,12 @@ /* Return the number of "extra" slots in the char table CT. */ -#define CHAR_TABLE_EXTRA_SLOTS(CT) \ - (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) +LISP_INLINE int +CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) +{ + return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) + - CHAR_TABLE_STANDARD_SLOTS); +} \f /*********************************************************************** @@ -1121,40 +1500,84 @@ /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) -#define SYMBOL_ALIAS(sym) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) - -#define SYMBOL_NAME(sym) XSYMBOL (sym)->name - -/* Value is non-zero if SYM is an interned symbol. */ - -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) - -/* Value is non-zero if SYM is interned in initial_obarray. */ - -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +LISP_INLINE Lisp_Object +(SYMBOL_VAL) (struct Lisp_Symbol *sym) +{ + return lisp_h_SYMBOL_VAL (sym); +} +LISP_INLINE struct Lisp_Symbol * +SYMBOL_ALIAS (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + return sym->val.alias; +} +LISP_INLINE struct Lisp_Buffer_Local_Value * +SYMBOL_BLV (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + return sym->val.blv; +} +LISP_INLINE union Lisp_Fwd * +SYMBOL_FWD (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + return sym->val.fwd; +} +LISP_INLINE void +(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +{ + lisp_h_SET_SYMBOL_VAL (sym, v); +} +LISP_INLINE void +SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + sym->val.alias = v; +} +LISP_INLINE void +SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + sym->val.blv = v; +} +LISP_INLINE void +SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + sym->val.fwd = v; +} + +LISP_INLINE Lisp_Object +SYMBOL_NAME (Lisp_Object sym) +{ + return XSYMBOL (sym)->name; +} + +/* Value is true if SYM is an interned symbol. */ + +LISP_INLINE bool +SYMBOL_INTERNED_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; +} + +/* Value is true if SYM is interned in initial_obarray. */ + +LISP_INLINE bool +SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; +} /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +LISP_INLINE int +(SYMBOL_CONSTANT_P) (Lisp_Object sym) +{ + return lisp_h_SYMBOL_CONSTANT_P (sym); +} #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1240,42 +1663,69 @@ }; -#define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) +LISP_INLINE struct Lisp_Hash_Table * +XHASH_TABLE (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) - -#define CHECK_HASH_TABLE(x) \ - CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) +LISP_INLINE bool +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} +LISP_INLINE void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} /* Value is the key part of entry IDX in hash table H. */ - -#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) +LISP_INLINE Lisp_Object +HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx); +} /* Value is the value part of entry IDX in hash table H. */ - -#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) +LISP_INLINE Lisp_Object +HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx + 1); +} /* Value is the index of the next entry following the one at IDX in hash table H. */ - -#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) +LISP_INLINE Lisp_Object +HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->next, idx); +} /* Value is the hash code computed for entry IDX in hash table H. */ - -#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) +LISP_INLINE Lisp_Object +HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->hash, idx); +} /* Value is the index of the element in hash table H that is the start of the collision list at index IDX in the index vector of H. */ - -#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) +LISP_INLINE Lisp_Object +HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->index, idx); +} /* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) +LISP_INLINE ptrdiff_t +HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) +{ + return ASIZE (h->next); +} /* Default size for hash tables if not specified. */ @@ -1485,6 +1935,53 @@ } data[SAVE_VALUE_SLOTS]; }; +/* Return the type of V's Nth saved value. */ +LISP_INLINE int +save_type (struct Lisp_Save_Value *v, int n) +{ + eassert (0 <= n && n < SAVE_VALUE_SLOTS); + return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); +} + +/* Get and set the Nth saved pointer. */ + +LISP_INLINE void * +XSAVE_POINTER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + return XSAVE_VALUE (obj)->data[n].pointer;; +} +LISP_INLINE void +set_save_pointer (Lisp_Object obj, int n, void *val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + XSAVE_VALUE (obj)->data[n].pointer = val; +} + +/* Likewise for the saved integer. */ + +LISP_INLINE ptrdiff_t +XSAVE_INTEGER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + return XSAVE_VALUE (obj)->data[n].integer; +} +LISP_INLINE void +set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + XSAVE_VALUE (obj)->data[n].integer = val; +} + +/* Extract Nth saved object. */ + +LISP_INLINE Lisp_Object +XSAVE_OBJECT (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); + return XSAVE_VALUE (obj)->data[n].object; +} + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -1506,6 +2003,46 @@ struct Lisp_Save_Value u_save_value; }; +LISP_INLINE union Lisp_Misc * +XMISC (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Misc); +} + +LISP_INLINE struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return & XMISC (a)->u_any; +} + +LISP_INLINE enum Lisp_Misc_Type +XMISCTYPE (Lisp_Object a) +{ + return XMISCANY (a)->type; +} + +LISP_INLINE struct Lisp_Marker * +XMARKER (Lisp_Object a) +{ + eassert (MARKERP (a)); + return & XMISC (a)->u_marker; +} + +LISP_INLINE struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) +{ + eassert (OVERLAYP (a)); + return & XMISC (a)->u_overlay; +} + +LISP_INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} +\f /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1612,6 +2149,47 @@ struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; + +LISP_INLINE enum Lisp_Fwd_Type +XFWDTYPE (union Lisp_Fwd *a) +{ + return a->u_intfwd.type; +} + +LISP_INLINE struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} + +LISP_INLINE struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} + +LISP_INLINE struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +LISP_INLINE struct Lisp_Buffer_Objfwd * +XBUFFER_OBJFWD (union Lisp_Fwd *a) +{ + eassert (BUFFER_OBJFWDP (a)); + return &a->u_buffer_objfwd; +} + +LISP_INLINE struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} \f /* Lisp floating point type. */ struct Lisp_Float @@ -1623,8 +2201,17 @@ } u; }; -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) -#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) +LISP_INLINE double +XFLOAT_DATA (Lisp_Object f) +{ + return XFLOAT (f)->u.data; +} + +LISP_INLINE void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on @@ -1633,8 +2220,12 @@ wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) +enum + { + IEEE_FLOATING_POINT + = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) + }; /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ @@ -1675,64 +2266,6 @@ itself. */ CHARACTERBITS = 22 }; - - - -\f -/* The glyph datatype, used to represent characters on the display. - It consists of a char code and a face id. */ - -typedef struct { - int ch; - int face_id; -} GLYPH; - -/* Return a glyph's character code. */ -#define GLYPH_CHAR(glyph) ((glyph).ch) - -/* Return a glyph's face ID. */ -#define GLYPH_FACE(glyph) ((glyph).face_id) - -#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) -#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) -#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) - -/* Return 1 if GLYPH contains valid character code. */ -#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) - - -/* Glyph Code from a display vector may either be an integer which - encodes a char code in the lower CHARACTERBITS bits and a (very small) - face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ - -#define GLYPH_CODE_P(gc) \ - (CONSP (gc) \ - ? (CHARACTERP (XCAR (gc)) \ - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ - : (RANGED_INTEGERP \ - (0, gc, \ - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ - ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ - : TYPE_MAXIMUM (EMACS_INT))))) - -/* The following are valid only if GLYPH_CODE_P (gc). */ - -#define GLYPH_CODE_CHAR(gc) \ - (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) - -#define GLYPH_CODE_FACE(gc) \ - (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) - -#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ - do \ - { \ - if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ - else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ - } \ - while (0) \f /* Structure to hold mouse highlight data. This is here because other header files need it for defining struct x_output etc. */ @@ -1768,190 +2301,321 @@ \f /* Data type checking. */ -#define NILP(x) EQ (x, Qnil) - -#define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) - -#define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) +LISP_INLINE bool +(NILP) (Lisp_Object x) +{ + return lisp_h_NILP (x); +} + +LISP_INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x); +} +LISP_INLINE bool +NATNUMP (Lisp_Object x) +{ + return INTEGERP (x) && 0 <= XINT (x); +} + +LISP_INLINE bool +RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +{ + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; +} + #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - -#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) -#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - -#define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) -#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) - + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + +LISP_INLINE bool +(CONSP) (Lisp_Object x) +{ + return lisp_h_CONSP (x); +} +LISP_INLINE bool +(FLOATP) (Lisp_Object x) +{ + return lisp_h_FLOATP (x); +} +LISP_INLINE bool +(MISCP) (Lisp_Object x) +{ + return lisp_h_MISCP (x); +} +LISP_INLINE bool +STRINGP (Lisp_Object x) +{ + return XTYPE (x) == Lisp_String; +} +LISP_INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return lisp_h_SYMBOLP (x); +} +LISP_INLINE bool +(INTEGERP) (Lisp_Object x) +{ + return lisp_h_INTEGERP (x); +} +LISP_INLINE bool +(VECTORLIKEP) (Lisp_Object x) +{ + return lisp_h_VECTORLIKEP (x); +} +LISP_INLINE bool +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} +LISP_INLINE bool +OVERLAYP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; +} +LISP_INLINE bool +(MARKERP) (Lisp_Object x) +{ + return lisp_h_MARKERP (x); +} LISP_INLINE bool SAVE_VALUEP (Lisp_Object x) { return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; } -LISP_INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; -} - -/* Return the type of V's Nth saved value. */ -LISP_INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -LISP_INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer;; -} -LISP_INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} - -/* Likewise for the saved integer. */ - -LISP_INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -LISP_INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -LISP_INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - -#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) - -#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) -#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) -#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) -#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) -#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - -/* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ -#define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) - -#define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) - -/* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ -#define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) +LISP_INLINE bool +AUTOLOADP (Lisp_Object x) +{ + return CONSP (x) && EQ (Qautoload, XCAR (x)); +} + +LISP_INLINE bool +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +LISP_INLINE bool +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +LISP_INLINE bool +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} +LISP_INLINE bool +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} +LISP_INLINE bool +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} + +LISP_INLINE bool +PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) +{ + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +LISP_INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } +} + /* Test for specific pseudovector types. */ -#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) -#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) + +LISP_INLINE bool +WINDOW_CONFIGURATIONP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); +} + +LISP_INLINE bool +PROCESSP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_PROCESS); +} + +LISP_INLINE bool +WINDOWP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW); +} + +LISP_INLINE bool +TERMINALP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TERMINAL); +} + +LISP_INLINE bool +SUBRP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUBR); +} + +LISP_INLINE bool +COMPILEDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_COMPILED); +} + +LISP_INLINE bool +BUFFERP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BUFFER); +} + +LISP_INLINE bool +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +LISP_INLINE bool +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); +} + +LISP_INLINE bool +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +LISP_INLINE bool +FRAMEP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_FRAME); +} /* Test for image (image . spec) */ -#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +LISP_INLINE bool +IMAGEP (Lisp_Object x) +{ + return CONSP (x) && EQ (XCAR (x), Qimage); +} /* Array types. */ - -#define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) +LISP_INLINE bool +ARRAYP (Lisp_Object x) +{ + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); +} \f -#define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - -#define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - -#define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - -#define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - -#define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - -#define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - -#define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - -#define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - -#define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - -#define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - -#define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - -#define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - -#define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - -#define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - -#define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - -#define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) - -#define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) - -#define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) +LISP_INLINE void +CHECK_LIST (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); +} +LISP_INLINE void +(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +{ + lisp_h_CHECK_LIST_CONS (x, y); +} +LISP_INLINE void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} +LISP_INLINE void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} +LISP_INLINE void +CHECK_STRING_CAR (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); +} +LISP_INLINE void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} +LISP_INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} +LISP_INLINE void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} +LISP_INLINE void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_STRING (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); +} +LISP_INLINE void +CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +{ + CHECK_TYPE (ARRAYP (x), Qxxxp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} +LISP_INLINE void +CHECK_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (BUFFERP (x), Qbufferp, x); +} +LISP_INLINE void +CHECK_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x), Qwindowp, x); +} +LISP_INLINE void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} +LISP_INLINE void +CHECK_PROCESS (Lisp_Object x) +{ + CHECK_TYPE (PROCESSP (x), Qprocessp, x); +} +LISP_INLINE void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} +LISP_INLINE void +(CHECK_NUMBER) (Lisp_Object x) +{ + lisp_h_CHECK_NUMBER (x); +} +LISP_INLINE void +CHECK_NATNUM (Lisp_Object x) +{ + CHECK_TYPE (NATNUMP (x), Qwholenump, x); +} #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@ -1972,57 +2636,76 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -#define CHECK_MARKER(x) \ - CHECK_TYPE (MARKERP (x), Qmarkerp, x) +LISP_INLINE void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) -#define XFLOATINT(n) extract_float((n)) - -#define CHECK_FLOAT(x) \ - CHECK_TYPE (FLOATP (x), Qfloatp, x) - -#define CHECK_NUMBER_OR_FLOAT(x) \ - CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) +LISP_INLINE double +XFLOATINT (Lisp_Object n) +{ + return extract_float (n); +} + +LISP_INLINE void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} +LISP_INLINE void +CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); +} #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -#define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) +LISP_INLINE void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ -#define CHECK_NUMBER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) +LISP_INLINE void +CHECK_NUMBER_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NUMBER_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} \f /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2088,8 +2771,12 @@ #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* Non-zero if OBJ is a Lisp function. */ -#define FUNCTIONP(OBJ) functionp(OBJ) +/* True if OBJ is a Lisp function. */ +LISP_INLINE bool +FUNCTIONP (Lisp_Object obj) +{ + return functionp (obj); +} /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ @@ -2276,7 +2963,11 @@ extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +LISP_INLINE ptrdiff_t +SPECPDL_INDEX (void) +{ + return specpdl_ptr - specpdl; +} /* Everything needed to describe an active condition case. @@ -2592,27 +3283,12 @@ #define EXFUN(fnname, maxargs) \ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs +#include "globals.h" + /* Forward declarations for prototypes. */ struct window; struct frame; -/* Simple access functions. */ - -LISP_INLINE Lisp_Object * -aref_addr (Lisp_Object array, ptrdiff_t idx) -{ - return & XVECTOR (array)->contents[idx]; -} - -LISP_INLINE void -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)); - XVECTOR (array)->contents[idx] = val; -} - /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ LISP_INLINE void @@ -2849,6 +3525,7 @@ extern Lisp_Object Qbuffer, Qinteger, Qsymbol; +extern Lisp_Object Qsubrp; extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; @@ -3237,7 +3914,7 @@ #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); #else -#define check_cons_list() ((void) 0) +LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } #endif #ifdef REL_ALLOC @@ -3305,10 +3982,12 @@ extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); -#define LOADHIST_ATTACH(x) \ - do { \ - if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ - } while (0) +LISP_INLINE void +LOADHIST_ATTACH (Lisp_Object x) +{ + if (initialized) + Vcurrent_load_list = Fcons (x, Vcurrent_load_list); +} extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object); extern Lisp_Object string_to_number (char const *, int, bool); @@ -3431,6 +4110,7 @@ extern Lisp_Object Vbuffer_alist; extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); +extern Lisp_Object Qoverlayp; extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); extern void init_buffer_once (void); @@ -3594,10 +4274,10 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -#define setlocale(category, locale) -#define fixup_locale() -#define synchronize_system_messages_locale() -#define synchronize_system_time_locale() +LISP_INLINE char *setlocale (int cat, char const *locale) { return 0; } +LISP_INLINE void fixup_locale (void) {} +LISP_INLINE void synchronize_system_messages_locale (void) {} +LISP_INLINE void synchronize_system_time_locale (void) {} #endif extern void shut_down_emacs (int, Lisp_Object); @@ -3956,8 +4636,6 @@ } while (0) -#include "globals.h" - /* Check whether it's time for GC, and run it if so. */ LISP_INLINE void @@ -3970,7 +4648,7 @@ Fgarbage_collect (); } -LISP_INLINE int +LISP_INLINE bool functionp (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) === modified file 'src/window.c' --- src/window.c 2013-06-04 16:33:46 +0000 +++ src/window.c 2013-06-09 19:42:53 +0000 @@ -55,7 +55,8 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_valid_p; -static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; +Lisp_Object Qwindow_configuration_p; +static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; === modified file 'src/window.h' --- src/window.h 2013-03-28 14:04:49 +0000 +++ src/window.h 2013-06-09 19:42:53 +0000 @@ -958,7 +958,7 @@ /* These used to be in lisp.h. */ -extern Lisp_Object Qwindowp, Qwindow_live_p; +extern Lisp_Object Qwindow_live_p; extern Lisp_Object Vwindow_list; extern struct window *decode_live_window (Lisp_Object); ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-13 14:45 ` Paul Eggert @ 2013-06-13 20:08 ` Stefan Monnier 2013-06-15 6:43 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2013-06-13 20:08 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 > + the operation's implementation. That way, OP can be implementated ^^^^^^^^^^^^^ implemented > +LISP_INLINE bool > +(LISP_INT_TAG_P) (int x) > +{ > + return lisp_h_LISP_INT_TAG_P (x); > +} Can't we use something like #define FUNCTION_OF_MACRO(fun, type_in, type_out) \ LISP_INLINE type_out (fun) (type_in x) { return lisp_h_##fun (x); } [ I guess it depends on whether the args to FUNCTION_OF_MACRO get macro-expanded before or after expanding the macro. ] Other than that, it looks OK for me, Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-13 20:08 ` Stefan Monnier @ 2013-06-15 6:43 ` Paul Eggert 2013-06-15 14:22 ` Stefan Monnier 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2013-06-15 6:43 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935 [-- Attachment #1: Type: text/plain, Size: 980 bytes --] On 06/13/2013 01:08 PM, Stefan Monnier wrote: > Can't we use something like > > #define FUNCTION_OF_MACRO(fun, type_in, type_out) \ > LISP_INLINE type_out (fun) (type_in x) { return lisp_h_##fun (x); } Sure, though we need to adjust that a bit, as the function can take multiple args, and it might return void (where the 'return' keyword must be omitted). The following variant works for me, and the attached combined patch implements this suggestion. /* Define NAME as a lisp.h inline function that returns TYPE and has arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and ARGS should be parenthesized. Implement the function by calling lisp_h_NAME ARGS. */ #define LISP_MACRO_DEFUN(name, type, argdecls, args) \ LISP_INLINE type (name) argdecls { return lisp_h_##name args; } /* like LISP_MACRO_DEFUN, except NAME returns void. */ #define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \ LISP_INLINE void (name) argdecls { lisp_h_##name args; } [-- Attachment #2: inline4o.txt --] [-- Type: text/plain, Size: 92181 bytes --] === modified file 'ChangeLog' --- ChangeLog 2013-06-11 18:05:05 +0000 +++ ChangeLog 2013-06-15 06:17:07 +0000 @@ -1,3 +1,9 @@ +2013-06-15 Paul Eggert <eggert@cs.ucla.edu> + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + 2013-06-11 Paul Eggert <eggert@cs.ucla.edu> --without-all should imply --with-file-notification=no. (Bug#14569) === modified file 'configure.ac' --- configure.ac 2013-06-13 06:28:05 +0000 +++ configure.ac 2013-06-13 15:38:03 +0000 @@ -776,6 +776,7 @@ # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-13 22:24:52 +0000 +++ src/ChangeLog 2013-06-15 06:17:07 +0000 @@ -1,3 +1,164 @@ +2013-06-15 Paul Eggert <eggert@cs.ucla.edu> + + Move functions from lisp.h to individual modules when possible. + From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>. + * alloc.c (XFLOAT_INIT, set_symbol_name): + * buffer.c (CHECK_OVERLAY): + * chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii) + (set_char_table_parent): + * coding.c (CHECK_NATNUM_CAR, CHECK_NATNUM_CDR): + * data.c (BOOLFWDP, INTFWDP, KBOARD_OBJFWDP, OBJFWDP, XBOOLFWD) + (XKBOARD_OBJFWD, XINTFWD, XOBJFWD, CHECK_SUBR, set_blv_found) + (blv_value, set_blv_value, set_blv_where, set_blv_defcell) + (set_blv_valcell): + * emacs.c (setlocale) [!HAVE_SETLOCALE]: + * eval.c (specpdl_symbol, specpdl_old_value, specpdl_where) + (specpdl_arg, specpdl_func, backtrace_function, backtrace_nargs) + (backtrace_args, backtrace_debug_on_exit): + * floatfns.c (CHECK_FLOAT): + * fns.c (CHECK_HASH_TABLE, CHECK_LIST_END) + (set_hash_key_and_value, set_hash_next, set_hash_next_slot) + (set_hash_hash, set_hash_hash_slot, set_hash_index) + (set_hash_index_slot): + * keymap.c (CHECK_VECTOR_OR_CHAR_TABLE): + * marker.c (CHECK_MARKER): + * textprop.c (CHECK_STRING_OR_BUFFER): + * window.c (CHECK_WINDOW_CONFIGURATION): + Move here from lisp.h, and make these functions static rather than + extern inline. + * buffer.c (Qoverlayp): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + * window.c (Qwindow_configuration_p): + Now static. + * lisp.h: Remove the abovementioned defns and decls. + + Use functions, not macros, for XINT etc. (Bug#11935). + In lisp.h, prefer functions to function-like macros, and + constants to object-like macros, when either will do. This: + . simplifies use, as there's no more need to worry about + arguments' side effects being evaluated multiple times. + . makes the code easier to debug on some platforms. + However, when using gcc -O0, keep using function-like macros + for a few critical operations, for performance reasons. + This sort of thing isn't needed with gcc -Og, but -Og + is a GCC 4.8 feature and isn't widely-enough available yet. + * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: + Remove enum lsb_bits; no longer needed. + (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue. + * buffer.c (Qoverlap): + * data.c (Qsubrp): + * fns.c (Qhash_table_p): + Now extern, so lisp.h can use these symbols. + * dispextern.h: Include character.h, for MAX_CHAR etc. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move here from lisp.h. + (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. + (GLYPH_MODE_LINE_FACE): Now enums, not macros. + * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since + XUNTAG now returns void *. + * lisp.h (lisp_h_XLI, lisp_h_XIL, lisp_h_CHECK_LIST_CONS) + (lisp_h_CHECK_NUMBER CHECK_SYMBOL, lisp_h_CHECK_TYPE) + (lisp_h_CONSP, lisp_h_EQ, lisp_h_FLOATP, lisp_h_INTEGERP) + (lisp_h_MARKERP, lisp_h_MISCP, lisp_h_NILP) + (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_CONSTANT_P) + (lisp_h_SYMBOL_VAL, lisp_h_SYMBOLP, lisp_h_VECTORLIKEP) + (lisp_h_XCAR, lisp_h_XCDR, lisp_h_XCONS, lisp_h_XHASH) + (lisp_h_XPNTR, lisp_h_XSYMBOL): + New macros, renamed from their sans-lisp_h_ counterparts. + (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL) + (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, MARKERP) + (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) + (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): + If compiling via GCC without optimization, define these as macros + in addition to inline functions. + To disable this, compile with -DINLINING=0. + (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): New macros. + (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise. + (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but + hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. + (INTMASK, VALMASK): Now macros, since static values cannot be + accessed from extern inline functions. + (VALMASK): Also a constant, for benefit of old GDB. + (LISP_INT_TAG_P): Remove; no longer needed as the only caller + is INTEGERP, which can fold it in. + (XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) + (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) + (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) + (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) + (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) + (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET) + (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF) + (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) + (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS) + (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) + (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) + (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) + (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE) + (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE) + (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE) + (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) + (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) + (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) + (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) + (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP) + (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP) + (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) + (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) + (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) + (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) + (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) + (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) + (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) + (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) + (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) + (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) + (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) + Now functions. + (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. + (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed. + (VALMASK): Define in one place rather than in two, merging the + USE_LSB_TAG parts; this is simpler. + (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM) + (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): + Move up, to avoid use before definition. + Also include "globals.h" earlier, for the same reason. + (make_natnum): New function. + (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. + (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) + (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) + (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) + (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) + (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) + (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) + (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) + (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) + (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) + (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) + (Qwindow_configuration_p, Qimage): New forward declarations. + (XSETFASTINT): Simplify by rewriting in terms of make_natnum. + (STRING_COPYIN): Remove; unused. + (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ... + (xcar_addr, xcdr_addr): New functions. All uses changed. + (IEEE_FLOATING_POINT): Now a constant, not a macro. + (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) + (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) + (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) + (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. + (TYPE_RANGED_INTEGERP): Simplify. + (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. + (setlocale, fixup_locale, synchronize_system_messages_locale) + (synchronize_system_time_locale) [!HAVE_SETLOCALE]: + Now empty functions, not macros. + (functionp): Return bool, not int. + * window.c (Qwindow_configuration_p): Now extern, + so window.h can use it. + * window.h (Qwindowp): Move decl back to lisp.h. + 2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca> * lread.c (syms_of_lread): === modified file 'src/alloc.c' --- src/alloc.c 2013-06-03 09:01:53 +0000 +++ src/alloc.c 2013-06-13 15:38:41 +0000 @@ -363,6 +363,11 @@ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ & ~ ((ALIGNMENT) - 1))) +static void +XFLOAT_INIT (Lisp_Object f, double n) +{ + XFLOAT (f)->u.data = n; +} \f /************************************************************************ @@ -3189,6 +3194,12 @@ static struct Lisp_Symbol *symbol_free_list; +static void +set_symbol_name (Lisp_Object sym, Lisp_Object name) +{ + XSYMBOL (sym)->name = name; +} + DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, doc: /* Return a newly allocated uninterned symbol whose name is NAME. Its value is void, and its function definition and property list are nil. */) @@ -3309,7 +3320,7 @@ --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; - XMISCTYPE (val) = type; + XMISCANY (val)->type = type; XMISCANY (val)->gcmarkbit = 0; return val; } @@ -3319,7 +3330,7 @@ void free_misc (Lisp_Object misc) { - XMISCTYPE (misc) = Lisp_Misc_Free; + XMISCANY (misc)->type = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); consing_since_gc -= sizeof (union Lisp_Misc); @@ -5647,7 +5658,7 @@ { CONS_MARK (XCONS (tail)); mark_object (XCAR (tail)); - prev = &XCDR_AS_LVALUE (tail); + prev = xcdr_addr (tail); } } mark_object (tail); @@ -6689,8 +6700,5 @@ enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; -#if USE_LSB_TAG - enum lsb_bits lsb_bits; -#endif } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ === modified file 'src/buffer.c' --- src/buffer.c 2013-05-07 14:12:57 +0000 +++ src/buffer.c 2013-06-13 15:56:46 +0000 @@ -150,6 +150,12 @@ static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); +static void +CHECK_OVERLAY (Lisp_Object x) +{ + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); +} + /* These setters are used only in this file, so they can be private. */ static void bset_abbrev_mode (struct buffer *b, Lisp_Object val) @@ -1539,7 +1545,7 @@ && BUFFER_LIVE_P (XBUFFER (b)) && !BUFFER_HIDDEN_P (XBUFFER (b))); } - + DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, doc: /* Return most recently selected buffer other than BUFFER. Buffers not visible in windows are preferred to visible buffers, unless === modified file 'src/chartab.c' --- src/chartab.c 2012-09-24 12:23:25 +0000 +++ src/chartab.c 2013-06-13 15:38:16 +0000 @@ -84,6 +84,22 @@ (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) +static void +CHECK_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); +} + +static void +set_char_table_ascii (Lisp_Object table, Lisp_Object val) +{ + XCHAR_TABLE (table)->ascii = val; +} +static void +set_char_table_parent (Lisp_Object table, Lisp_Object val) +{ + XCHAR_TABLE (table)->parent = val; +} \f DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, doc: /* Return a newly created char-table, with purpose PURPOSE. === modified file 'src/coding.c' --- src/coding.c 2013-05-22 14:53:21 +0000 +++ src/coding.c 2013-06-13 15:38:16 +0000 @@ -655,6 +655,22 @@ (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ } while (0) +static void +CHECK_NATNUM_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NATNUM (tmp); + XSETCAR (x, tmp); +} + +static void +CHECK_NATNUM_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NATNUM (tmp); + XSETCDR (x, tmp); +} + /* Safely get one byte from the source text pointed by SRC which ends at SRC_END, and set C to that byte. If there are not enough bytes === modified file 'src/data.c' --- src/data.c 2013-06-03 18:29:30 +0000 +++ src/data.c 2013-06-13 15:56:52 +0000 @@ -76,7 +76,8 @@ static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; -static Lisp_Object Qsubrp, Qmany, Qunevalled; +static Lisp_Object Qsubrp; +static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; @@ -85,6 +86,94 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); +static bool +BOOLFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Bool; +} +static bool +INTFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Int; +} +static bool +KBOARD_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; +} +static bool +OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Obj; +} + +static struct Lisp_Boolfwd * +XBOOLFWD (union Lisp_Fwd *a) +{ + eassert (BOOLFWDP (a)); + return &a->u_boolfwd; +} +static struct Lisp_Kboard_Objfwd * +XKBOARD_OBJFWD (union Lisp_Fwd *a) +{ + eassert (KBOARD_OBJFWDP (a)); + return &a->u_kboard_objfwd; +} +static struct Lisp_Intfwd * +XINTFWD (union Lisp_Fwd *a) +{ + eassert (INTFWDP (a)); + return &a->u_intfwd; +} +static struct Lisp_Objfwd * +XOBJFWD (union Lisp_Fwd *a) +{ + eassert (OBJFWDP (a)); + return &a->u_objfwd; +} + +static void +CHECK_SUBR (Lisp_Object x) +{ + CHECK_TYPE (SUBRP (x), Qsubrp, x); +} + +static void +set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) +{ + eassert (found == !EQ (blv->defcell, blv->valcell)); + blv->found = found; +} + +static Lisp_Object +blv_value (struct Lisp_Buffer_Local_Value *blv) +{ + return XCDR (blv->valcell); +} + +static void +set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + XSETCDR (blv->valcell, val); +} + +static void +set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->where = val; +} + +static void +set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->defcell = val; +} + +static void +set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) +{ + blv->valcell = val; +} Lisp_Object wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) === modified file 'src/dispextern.h' --- src/dispextern.h 2013-06-08 18:28:36 +0000 +++ src/dispextern.h 2013-06-13 15:38:03 +0000 @@ -22,6 +22,8 @@ #ifndef DISPEXTERN_H_INCLUDED #define DISPEXTERN_H_INCLUDED +#include "character.h" + #ifdef HAVE_X_WINDOWS #include <X11/Xlib.h> @@ -270,6 +272,55 @@ Glyphs ***********************************************************************/ +/* The glyph datatype, used to represent characters on the display. + It consists of a char code and a face id. */ + +typedef struct { + int ch; + int face_id; +} GLYPH; + +/* Return a glyph's character code. */ +DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } + +/* Return a glyph's face ID. */ +DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } + +#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) +#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) +#define SET_GLYPH(glyph, char, face) \ + ((glyph).ch = (char), (glyph).face_id = (face)) + +/* The following are valid only if GLYPH_CODE_P (gc). */ + +DISPEXTERN_INLINE int +GLYPH_CODE_CHAR (Lisp_Object gc) +{ + return (CONSP (gc) + ? XINT (XCAR (gc)) + : XINT (gc) & MAX_CHAR); +} + +DISPEXTERN_INLINE int +GLYPH_CODE_FACE (Lisp_Object gc) +{ + return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; +} + +#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ + do \ + { \ + if (CONSP (gc)) \ + SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ + else \ + SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ + (XINT (gc) >> CHARACTERBITS)); \ + } \ + while (0) + +/* The ID of the mode line highlighting face. */ +enum { GLYPH_MODE_LINE_FACE = 1 }; + /* Enumeration of glyph types. Glyph structures contain a type field containing one of the enumerators defined here. */ @@ -1774,6 +1825,30 @@ #endif /* not HAVE_WINDOW_SYSTEM */ +/* Return true if G contains a valid character code. */ +DISPEXTERN_INLINE bool +GLYPH_CHAR_VALID_P (GLYPH g) +{ + return CHAR_VALID_P (GLYPH_CHAR (g)); +} + +/* The glyph code from a display vector may either be an integer which + encodes a char code in the lower CHARACTERBITS bits and a (very small) + face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ + +DISPEXTERN_INLINE bool +GLYPH_CODE_P (Lisp_Object gc) +{ + return (CONSP (gc) + ? (CHARACTERP (XCAR (gc)) + && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) + : (RANGED_INTEGERP + (0, gc, + (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR + : TYPE_MAXIMUM (EMACS_INT))))); +} + /* Non-zero means face attributes have been changed since the last redisplay. Used in redisplay_internal. */ === modified file 'src/emacs.c' --- src/emacs.c 2013-06-05 12:17:02 +0000 +++ src/emacs.c 2013-06-13 15:38:16 +0000 @@ -306,6 +306,13 @@ static void *ns_pool; #endif +#if !HAVE_SETLOCALE +static char * +setlocale (int cat, char const *locale) +{ + return 0; +} +#endif /* Report a fatal error due to signal SIG, output a backtrace of at === modified file 'src/eval.c' --- src/eval.c 2013-06-03 18:29:30 +0000 +++ src/eval.c 2013-06-13 15:44:00 +0000 @@ -115,6 +115,69 @@ static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); +static Lisp_Object +specpdl_symbol (struct specbinding *pdl) +{ + eassert (pdl->kind >= SPECPDL_LET); + return pdl->v.let.symbol; +} + +static Lisp_Object +specpdl_old_value (struct specbinding *pdl) +{ + eassert (pdl->kind >= SPECPDL_LET); + return pdl->v.let.old_value; +} + +static Lisp_Object +specpdl_where (struct specbinding *pdl) +{ + eassert (pdl->kind > SPECPDL_LET); + return pdl->v.let.where; +} + +static Lisp_Object +specpdl_arg (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->v.unwind.arg; +} + +static specbinding_func +specpdl_func (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->v.unwind.func; +} + +static Lisp_Object +backtrace_function (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.function; +} + +static ptrdiff_t +backtrace_nargs (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.nargs; +} + +static Lisp_Object * +backtrace_args (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.args; +} + +static bool +backtrace_debug_on_exit (struct specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->v.bt.debug_on_exit; +} + /* Functions to modify slots of backtrace records. */ static void === modified file 'src/floatfns.c' --- src/floatfns.c 2013-03-24 12:59:45 +0000 +++ src/floatfns.c 2013-06-13 15:38:16 +0000 @@ -41,6 +41,14 @@ # define isnan(x) ((x) != (x)) #endif +/* Check that X is a floating point number. */ + +static void +CHECK_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x), Qfloatp, x); +} + /* Extract a Lisp number as a `double', or signal an error. */ double === modified file 'src/fns.c' --- src/fns.c 2013-06-13 22:24:52 +0000 +++ src/fns.c 2013-06-15 06:17:07 +0000 @@ -91,6 +91,12 @@ /* Random data-structure functions. */ +static void +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE (NILP (x), Qlistp, y); +} + DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. @@ -3337,7 +3343,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; +static Lisp_Object Qhash_table_p; +static Lisp_Object Qkey, Qvalue, Qeql; Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; @@ -3347,6 +3354,48 @@ Utilities ***********************************************************************/ +static void +CHECK_HASH_TABLE (Lisp_Object x) +{ + return CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); +} + +static void +set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) +{ + h->key_and_value = key_and_value; +} +static void +set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) +{ + h->next = next; +} +static void +set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->next, idx, val); +} +static void +set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) +{ + h->hash = hash; +} +static void +set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->hash, idx, val); +} +static void +set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) +{ + h->index = index; +} +static void +set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->index, idx, val); +} + /* If OBJ is a Lisp hash table, return a pointer to its struct Lisp_Hash_Table. Otherwise, signal an error. */ === modified file 'src/keymap.c' --- src/keymap.c 2013-06-05 01:58:43 +0000 +++ src/keymap.c 2013-06-13 15:38:16 +0000 @@ -106,6 +106,12 @@ Lisp_Object, Lisp_Object, bool, bool); static void silly_event_symbol_error (Lisp_Object); static Lisp_Object get_keyelt (Lisp_Object, bool); + +static void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} \f /* Keymap object support - constructors and predicates. */ === modified file 'src/lisp.h' --- src/lisp.h 2013-06-05 12:17:02 +0000 +++ src/lisp.h 2013-06-15 06:33:27 +0000 @@ -220,6 +220,139 @@ #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. + There's no need to inline everything, just the operations that + would otherwise cause a serious performance problem. + + For each such operation OP, define a macro lisp_h_OP that contains + the operation's implementation. That way, OP can be implementated + via a macro definition like this: + + #define OP(x) lisp_h_OP (x) + + and/or via a function definition like this: + + LISP_MACRO_DEFUN (OP, Lisp_Object, (Lisp_Object x), (x)) + + which macro-expands to this: + + Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); } + + without worrying about the implementations diverging, since + lisp_h_OP defines the actual implementation. The lisp_h_OP macros + are intended to be private to this include file, and should not be + used elsewhere. + + FIXME: Remove the lisp_h_OP macros, and define just the inline OP + functions, once most developers have access to GCC 4.8 or later and + can use "gcc -Og" to debug. Maybe in the year 2016. See + Bug#11935. + + 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 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) \ + ((void) ((ok) || 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_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_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) | DATA_SEG_BITS)) +#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) (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=0. */ +#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 NAME as a lisp.h inline function that returns TYPE and has + arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and + ARGS should be parenthesized. Implement the function by calling + lisp_h_NAME ARGS. */ +#define LISP_MACRO_DEFUN(name, type, argdecls, args) \ + LISP_INLINE type (name) argdecls { return lisp_h_##name args; } + +/* like LISP_MACRO_DEFUN, except NAME returns void. */ +#define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \ + LISP_INLINE void (name) argdecls { lisp_h_##name args; } + + /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. If you want to define a new @@ -230,7 +363,6 @@ 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 LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, and xlc complains vociferously about them. */ @@ -359,20 +491,6 @@ typedef struct { EMACS_INT i; } Lisp_Object; -#define XLI(o) (o).i -LISP_INLINE Lisp_Object -XIL (EMACS_INT i) -{ - Lisp_Object o = { i }; - return o; -} - -LISP_INLINE Lisp_Object -LISP_MAKE_RVALUE (Lisp_Object o) -{ - return o; -} - #define LISP_INITIALLY_ZERO {0} #undef CHECK_LISP_OBJECT_TYPE @@ -382,13 +500,15 @@ /* If a struct type is not wanted, define Lisp_Object as just a number. */ typedef EMACS_INT Lisp_Object; -#define XLI(o) (o) -#define XIL(i) (i) -#define LISP_MAKE_RVALUE(o) (0 + (o)) #define LISP_INITIALLY_ZERO 0 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; #endif /* CHECK_LISP_OBJECT_TYPE */ +/* 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. */ static ptrdiff_t const ARRAY_MARK_FLAG @@ -460,85 +580,109 @@ BOOL_VECTOR_BITS_PER_CHAR = 8 }; \f -/* These macros extract various sorts of values from a Lisp_Object. +/* These functions extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -#if USE_LSB_TAG - -enum lsb_bits - { - TYPEMASK = (1 << GCTYPEBITS) - 1, - VALMASK = ~ TYPEMASK - }; -#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) -#define XINT(a) (XLI (a) >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) -#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) -#define make_lisp_ptr(ptr, type) \ - (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ - XIL ((type) | (intptr_t) (ptr))) - -#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) -#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) - -#else /* not USE_LSB_TAG */ - static EMACS_INT const VALMASK -#define VALMASK VAL_MAX +#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) = VALMASK; -#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp integers have zero-bits in their tags. */ -#define XFASTINT(a) (XLI (a) + 0) -#define XSETFASTINT(a, b) ((a) = XIL (b)) - -/* Extract the value of a Lisp_Object as a (un)signed integer. */ - -#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) -#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) -#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) - -#define make_lisp_ptr(ptr, type) \ - (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object. */ -#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) - -#endif /* not USE_LSB_TAG */ - -/* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be - like XUINT right now, but XUINT should only be applied to objects we know - are integers. */ -#define XHASH(a) XUINT (a) - -/* For integers known to be positive, XFASTINT sometimes provides - faster retrieval and XSETFASTINT provides faster storage. - If not, fallback on the non-accelerated path. */ -#ifndef XFASTINT -# define XFASTINT(a) (XINT (a)) -# define XSETFASTINT(a, b) (XSETINT (a, b)) -#endif - -/* Extract the pointer value of the Lisp object A, under the - assumption that A's type is TYPE. This is a fallback - implementation if nothing faster is available. */ -#ifndef XUNTAG -# define XUNTAG(a, type) XPNTR (a) -#endif - -#define EQ(x, y) (XLI (x) == XLI (y)) - /* 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. */ + +/* Make a Lisp integer representing the value of the low order + bits of N. */ +LISP_INLINE Lisp_Object +make_number (EMACS_INT n) +{ + return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); +} + +/* Extract A's value as a signed integer. */ +LISP_INLINE EMACS_INT +XINT (Lisp_Object a) +{ + EMACS_INT i = XLI (a); + return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; +} + +/* Like XINT (A), but may be faster. A must be nonnegative. + If ! USE_LSB_TAG, this takes advantage of the fact that Lisp + integers have zero-bits in their tags. */ +LISP_INLINE EMACS_INT +XFASTINT (Lisp_Object a) +{ + EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a); + eassert (0 <= n); + return n; +} + +/* Extract A's type. */ +LISP_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. */ +LISP_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. */ +LISP_INLINE EMACS_UINT +XUINT (Lisp_Object a) +{ + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; +} + +/* Return A's (Lisp-integer sized) hash. Happens to be like XUINT + right now, but XUINT should only be applied to objects we know are + integers. */ +LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a)) + +/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +LISP_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 true if X and Y are the same object. */ +LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y)) + /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned type or if I is a NaN. */ @@ -551,66 +695,173 @@ { return num < lower ? lower : num <= upper ? num : upper; } - -\f +\f +/* Forward declarations. */ + +/* Defined in this file. */ +union Lisp_Fwd; +LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); +LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); +LISP_INLINE bool BUFFERP (Lisp_Object); +LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); +LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); +LISP_INLINE bool (CONSP) (Lisp_Object); +LISP_INLINE bool (FLOATP) (Lisp_Object); +LISP_INLINE bool functionp (Lisp_Object); +LISP_INLINE bool (INTEGERP) (Lisp_Object); +LISP_INLINE bool (MARKERP) (Lisp_Object); +LISP_INLINE bool (MISCP) (Lisp_Object); +LISP_INLINE bool (NILP) (Lisp_Object); +LISP_INLINE bool OVERLAYP (Lisp_Object); +LISP_INLINE bool PROCESSP (Lisp_Object); +LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); +LISP_INLINE bool SAVE_VALUEP (Lisp_Object); +LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, + Lisp_Object); +LISP_INLINE bool STRINGP (Lisp_Object); +LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); +LISP_INLINE bool SUBRP (Lisp_Object); +LISP_INLINE bool (SYMBOLP) (Lisp_Object); +LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); +LISP_INLINE bool WINDOWP (Lisp_Object); +LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + +/* Defined in chartab.c. */ +extern Lisp_Object char_table_ref (Lisp_Object, int); +extern void char_table_set (Lisp_Object, int, Lisp_Object); +extern int char_table_translate (Lisp_Object, int); + +/* Defined in data.c. */ +extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; +extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; +extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qvector_or_char_table_p, Qwholenump; +extern Lisp_Object Ffboundp (Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + +/* Defined in emacs.c. */ +extern bool initialized; + +/* Defined in eval.c. */ +extern Lisp_Object Qautoload; + +/* Defined in floatfns.c. */ +extern double extract_float (Lisp_Object); + +/* Defined in process.c. */ +extern Lisp_Object Qprocessp; + +/* Defined in window.c. */ +extern Lisp_Object Qwindowp; + +/* Defined in xdisp.c. */ +extern Lisp_Object Qimage; +\f + /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) -#define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) -#define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) - -/* Misc types. */ - -#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) -#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) -#define XMISCTYPE(a) (XMISCANY (a)->type) -#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) -#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) - -/* Forwarding object types. */ - -#define XFWDTYPE(a) (a->u_intfwd.type) -#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) -#define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) -#define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) +LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a)) + +LISP_INLINE struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + +LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) + +LISP_INLINE struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} /* Pseudovector types. */ -struct Lisp_Process; -LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) -{ return make_lisp_ptr (p, Lisp_Vectorlike); } -#define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) -#define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ - ((struct Lisp_Bool_Vector *) \ - XUNTAG (a, Lisp_Vectorlike))) + +LISP_INLINE struct Lisp_Process * +XPROCESS (Lisp_Object a) +{ + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct window * +XWINDOW (Lisp_Object a) +{ + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct terminal * +XTERMINAL (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct buffer * +XBUFFER (Lisp_Object a) +{ + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_INLINE struct Lisp_Sub_Char_Table * +XSUB_CHAR_TABLE (Lisp_Object a) +{ + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +LISP_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. */ +LISP_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; +} + +LISP_INLINE Lisp_Object +make_lisp_proc (struct Lisp_Process *p) +{ + return make_lisp_ptr (p, Lisp_Vectorlike); +} + #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)) @@ -656,35 +907,10 @@ #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -/* Convenience macros for dealing with Lisp arrays. */ - -#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] -#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size -#define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) - -/* Convenience macros for dealing with Lisp strings. */ - -#define SDATA(string) (XSTRING (string)->data + 0) -#define SREF(string, index) (SDATA (string)[index] + 0) -#define SSET(string, index, new) (SDATA (string)[index] = (new)) -#define SCHARS(string) (XSTRING (string)->size + 0) -#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - -/* Avoid "differ in sign" warnings. */ -#define SSDATA(x) ((char *) SDATA (x)) - -#define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - -#define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ -#define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) +LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), + (ok, Qxxxp, x)) /* Deprecated and will be removed soon. */ @@ -694,10 +920,6 @@ typedef struct interval *INTERVAL; -/* Complain if object is not string or buffer type. */ -#define CHECK_STRING_OR_BUFFER(x) \ - CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) - struct Lisp_Cons { /* Car of this cons cell. */ @@ -714,64 +936,86 @@ }; /* Take the car or cdr of something known to be a cons cell. */ -/* The _AS_LVALUE macros shouldn't be used outside of the minimal set +/* 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 as lvalues. (What if we want to switch to + 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.) */ -#define XCAR_AS_LVALUE(c) (XCONS (c)->car) -#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) +LISP_INLINE Lisp_Object * +xcar_addr (Lisp_Object c) +{ + return &XCONS (c)->car; +} +LISP_INLINE Lisp_Object * +xcdr_addr (Lisp_Object c) +{ + return &XCONS (c)->u.cdr; +} /* Use these from normal code. */ -#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) -#define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) +LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c)) +LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c)) /* Use these to set the fields of a cons cell. Note that both arguments may refer to the same object, so 'n' - should not be read after 'c' is first modified. Also, neither - argument should be evaluated more than once; side effects are - especially common in the second argument. */ -#define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) -#define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR(c) \ - (CONSP ((c)) ? XCAR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -#define CDR(c) \ - (CONSP ((c)) ? XCDR ((c)) \ - : NILP ((c)) ? Qnil \ - : wrong_type_argument (Qlistp, (c))) - -/* Take the car or cdr of something whose type is not known. */ -#define CAR_SAFE(c) \ - (CONSP ((c)) ? XCAR ((c)) : Qnil) - -#define CDR_SAFE(c) \ - (CONSP ((c)) ? XCDR ((c)) : Qnil) + should not be read after 'c' is first modified. */ +LISP_INLINE void +XSETCAR (Lisp_Object c, Lisp_Object n) +{ + *xcar_addr (c) = n; +} +LISP_INLINE void +XSETCDR (Lisp_Object c, Lisp_Object n) +{ + *xcdr_addr (c) = n; +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR (Lisp_Object c) +{ + return (CONSP (c) ? XCAR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} +LISP_INLINE Lisp_Object +CDR (Lisp_Object c) +{ + return (CONSP (c) ? XCDR (c) + : NILP (c) ? Qnil + : wrong_type_argument (Qlistp, c)); +} + +/* Take the car or cdr of something whose type is not known. */ +LISP_INLINE Lisp_Object +CAR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCAR (c) : Qnil; +} +LISP_INLINE Lisp_Object +CDR_SAFE (Lisp_Object c) +{ + return CONSP (c) ? XCDR (c) : Qnil; +} + +/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + +struct Lisp_String + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + }; /* True if STR is a multibyte string. */ -#define STRING_MULTIBYTE(STR) \ - (XSTRING (STR)->size_byte >= 0) - -/* Return the length in bytes of STR. */ - -#ifdef GC_CHECK_STRING_BYTES - -struct Lisp_String; -extern ptrdiff_t string_bytes (struct Lisp_String *); -#define STRING_BYTES(S) string_bytes ((S)) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define STRING_BYTES(STR) \ - ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) - -#endif /* not GC_CHECK_STRING_BYTES */ +LISP_INLINE bool +STRING_MULTIBYTE (Lisp_Object str) +{ + return 0 <= XSTRING (str)->size_byte; +} /* An upper bound on the number of bytes in a Lisp string, not counting the terminating null. This a tight enough bound to @@ -802,20 +1046,65 @@ (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ +/* Convenience functions for dealing with Lisp strings. */ -struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; +LISP_INLINE unsigned char * +SDATA (Lisp_Object string) +{ + return XSTRING (string)->data; +} +LISP_INLINE char * +SSDATA (Lisp_Object string) +{ + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); +} +LISP_INLINE unsigned char +SREF (Lisp_Object string, ptrdiff_t index) +{ + return SDATA (string)[index]; +} +LISP_INLINE void +SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) +{ + SDATA (string)[index] = new; +} +LISP_INLINE ptrdiff_t +SCHARS (Lisp_Object string) +{ + return XSTRING (string)->size; +} +LISP_INLINE ptrdiff_t +STRING_BYTES (struct Lisp_String *s) +{ +#ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + return string_bytes (s); +#else + return s->size_byte < 0 ? s->size : s->size_byte; +#endif +} +LISP_INLINE ptrdiff_t +SBYTES (Lisp_Object string) +{ + return STRING_BYTES (XSTRING (string)); +} +LISP_INLINE void +STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) +{ + XSTRING (string)->size = newsize; +} +LISP_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 - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ @@ -874,6 +1163,42 @@ word_size = sizeof (Lisp_Object) }; +/* Conveniences for dealing with Lisp arrays. */ + +LISP_INLINE Lisp_Object +AREF (Lisp_Object array, ptrdiff_t idx) +{ + return XVECTOR (array)->contents[idx]; +} + +LISP_INLINE Lisp_Object * +aref_addr (Lisp_Object array, ptrdiff_t idx) +{ + return & XVECTOR (array)->contents[idx]; +} + +LISP_INLINE ptrdiff_t +ASIZE (Lisp_Object array) +{ + return XVECTOR (array)->header.size; +} + +LISP_INLINE void +ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + eassert (0 <= idx && idx < ASIZE (array)); + XVECTOR (array)->contents[idx] = val; +} + +LISP_INLINE void +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)); + XVECTOR (array)->contents[idx] = val; +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ @@ -887,43 +1212,6 @@ #define PSEUDOVECSIZE(type, nonlispfield) \ ((offsetof (type, nonlispfield) - header_size) / word_size) -/* A char-table is a kind of vectorlike, with contents are like a - vector but with a few other slots. For some purposes, it makes - sense to handle a char-table with type struct Lisp_Vector. An - element of a char table can be any Lisp objects, but if it is a sub - char-table, we treat it a table that contains information of a - specific range of characters. A sub char-table has the same - structure as a vector. A sub char table appears only in an element - of a char-table, and there's no way to access it directly from - Emacs Lisp program. */ - -#ifdef __GNUC__ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - ({struct Lisp_Char_Table *_tbl = NULL; \ - Lisp_Object _val; \ - do { \ - _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ - _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ - : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ - if (NILP (_val)) \ - _val = _tbl->defalt; \ - } while (NILP (_val) && ! NILP (_tbl->parent)); \ - _val; }) - -#else /* not __GNUC__ */ - -#define CHAR_TABLE_REF_ASCII(CT, IDX) \ - (! NILP (XCHAR_TABLE (CT)->ascii) \ - ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? XCHAR_TABLE (CT)->ascii \ - : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ - ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ - : char_table_ref ((CT), (IDX))) \ - : char_table_ref ((CT), (IDX))) - -#endif /* not __GNUC__ */ - /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) @@ -937,18 +1225,15 @@ /* Nonzero iff C is an ASCII character. */ #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - characters. Do not check validity of CT. */ -#define CHAR_TABLE_REF(CT, IDX) \ - (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ - : char_table_ref ((CT), (IDX))) - -/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit European characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ - ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \ - : char_table_set (CT, IDX, VAL)) +/* A char-table is a kind of vectorlike, with contents are like a + vector but with a few other slots. For some purposes, it makes + sense to handle a char-table with type struct Lisp_Vector. An + element of a char table can be any Lisp objects, but if it is a sub + char-table, we treat it a table that contains information of a + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ enum CHARTAB_SIZE_BITS { @@ -1012,6 +1297,45 @@ Lisp_Object contents[1]; }; +LISP_INLINE Lisp_Object +CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) +{ + struct Lisp_Char_Table *tbl = NULL; + Lisp_Object val; + do + { + tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); + val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii + : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + if (NILP (val)) + val = tbl->defalt; + } + while (NILP (val) && ! NILP (tbl->parent)); + + return val; +} + +/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII + characters. Do not check validity of CT. */ +LISP_INLINE Lisp_Object +CHAR_TABLE_REF (Lisp_Object ct, int idx) +{ + return (ASCII_CHAR_P (idx) + ? CHAR_TABLE_REF_ASCII (ct, idx) + : char_table_ref (ct, idx)); +} + +/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and + 8-bit European characters. Do not check validity of CT. */ +LISP_INLINE void +CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) +{ + if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) + set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val); + else + 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. */ @@ -1048,8 +1372,12 @@ /* Return the number of "extra" slots in the char table CT. */ -#define CHAR_TABLE_EXTRA_SLOTS(CT) \ - (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) +LISP_INLINE int +CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) +{ + return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) + - CHAR_TABLE_STANDARD_SLOTS); +} \f /*********************************************************************** @@ -1121,40 +1449,76 @@ /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) -#define SYMBOL_ALIAS(sym) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) - -#define SYMBOL_NAME(sym) XSYMBOL (sym)->name - -/* Value is non-zero if SYM is an interned symbol. */ - -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) - -/* Value is non-zero if SYM is interned in initial_obarray. */ - -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) + +LISP_INLINE struct Lisp_Symbol * +SYMBOL_ALIAS (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + return sym->val.alias; +} +LISP_INLINE struct Lisp_Buffer_Local_Value * +SYMBOL_BLV (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + return sym->val.blv; +} +LISP_INLINE union Lisp_Fwd * +SYMBOL_FWD (struct Lisp_Symbol *sym) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + return sym->val.fwd; +} + +LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL, + (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v)) + +LISP_INLINE void +SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) +{ + eassert (sym->redirect == SYMBOL_VARALIAS); + sym->val.alias = v; +} +LISP_INLINE void +SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) +{ + eassert (sym->redirect == SYMBOL_LOCALIZED); + sym->val.blv = v; +} +LISP_INLINE void +SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) +{ + eassert (sym->redirect == SYMBOL_FORWARDED); + sym->val.fwd = v; +} + +LISP_INLINE Lisp_Object +SYMBOL_NAME (Lisp_Object sym) +{ + return XSYMBOL (sym)->name; +} + +/* Value is true if SYM is an interned symbol. */ + +LISP_INLINE bool +SYMBOL_INTERNED_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; +} + +/* Value is true if SYM is interned in initial_obarray. */ + +LISP_INLINE bool +SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) +{ + return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; +} /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) #define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1240,42 +1604,64 @@ }; -#define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) +LISP_INLINE struct Lisp_Hash_Table * +XHASH_TABLE (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Vectorlike); +} #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) -#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) - -#define CHECK_HASH_TABLE(x) \ - CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) +LISP_INLINE bool +HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_HASH_TABLE); +} /* Value is the key part of entry IDX in hash table H. */ - -#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) +LISP_INLINE Lisp_Object +HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx); +} /* Value is the value part of entry IDX in hash table H. */ - -#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) +LISP_INLINE Lisp_Object +HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->key_and_value, 2 * idx + 1); +} /* Value is the index of the next entry following the one at IDX in hash table H. */ - -#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) +LISP_INLINE Lisp_Object +HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->next, idx); +} /* Value is the hash code computed for entry IDX in hash table H. */ - -#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) +LISP_INLINE Lisp_Object +HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->hash, idx); +} /* Value is the index of the element in hash table H that is the start of the collision list at index IDX in the index vector of H. */ - -#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) +LISP_INLINE Lisp_Object +HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return AREF (h->index, idx); +} /* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) ASIZE ((H)->next) +LISP_INLINE ptrdiff_t +HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) +{ + return ASIZE (h->next); +} /* Default size for hash tables if not specified. */ @@ -1485,6 +1871,53 @@ } data[SAVE_VALUE_SLOTS]; }; +/* Return the type of V's Nth saved value. */ +LISP_INLINE int +save_type (struct Lisp_Save_Value *v, int n) +{ + eassert (0 <= n && n < SAVE_VALUE_SLOTS); + return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); +} + +/* Get and set the Nth saved pointer. */ + +LISP_INLINE void * +XSAVE_POINTER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + return XSAVE_VALUE (obj)->data[n].pointer;; +} +LISP_INLINE void +set_save_pointer (Lisp_Object obj, int n, void *val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + XSAVE_VALUE (obj)->data[n].pointer = val; +} + +/* Likewise for the saved integer. */ + +LISP_INLINE ptrdiff_t +XSAVE_INTEGER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + return XSAVE_VALUE (obj)->data[n].integer; +} +LISP_INLINE void +set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + XSAVE_VALUE (obj)->data[n].integer = val; +} + +/* Extract Nth saved object. */ + +LISP_INLINE Lisp_Object +XSAVE_OBJECT (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); + return XSAVE_VALUE (obj)->data[n].object; +} + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -1506,6 +1939,46 @@ struct Lisp_Save_Value u_save_value; }; +LISP_INLINE union Lisp_Misc * +XMISC (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Misc); +} + +LISP_INLINE struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return & XMISC (a)->u_any; +} + +LISP_INLINE enum Lisp_Misc_Type +XMISCTYPE (Lisp_Object a) +{ + return XMISCANY (a)->type; +} + +LISP_INLINE struct Lisp_Marker * +XMARKER (Lisp_Object a) +{ + eassert (MARKERP (a)); + return & XMISC (a)->u_marker; +} + +LISP_INLINE struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) +{ + eassert (OVERLAYP (a)); + return & XMISC (a)->u_overlay; +} + +LISP_INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} +\f /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1612,6 +2085,19 @@ struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; + +LISP_INLINE enum Lisp_Fwd_Type +XFWDTYPE (union Lisp_Fwd *a) +{ + return a->u_intfwd.type; +} + +LISP_INLINE struct Lisp_Buffer_Objfwd * +XBUFFER_OBJFWD (union Lisp_Fwd *a) +{ + eassert (BUFFER_OBJFWDP (a)); + return &a->u_buffer_objfwd; +} \f /* Lisp floating point type. */ struct Lisp_Float @@ -1623,8 +2109,11 @@ } u; }; -#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) -#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) +LISP_INLINE double +XFLOAT_DATA (Lisp_Object f) +{ + return XFLOAT (f)->u.data; +} /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on @@ -1633,8 +2122,12 @@ wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) +enum + { + IEEE_FLOATING_POINT + = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) + }; /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ @@ -1675,64 +2168,6 @@ itself. */ CHARACTERBITS = 22 }; - - - -\f -/* The glyph datatype, used to represent characters on the display. - It consists of a char code and a face id. */ - -typedef struct { - int ch; - int face_id; -} GLYPH; - -/* Return a glyph's character code. */ -#define GLYPH_CHAR(glyph) ((glyph).ch) - -/* Return a glyph's face ID. */ -#define GLYPH_FACE(glyph) ((glyph).face_id) - -#define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) -#define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) -#define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) - -/* Return 1 if GLYPH contains valid character code. */ -#define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) - - -/* Glyph Code from a display vector may either be an integer which - encodes a char code in the lower CHARACTERBITS bits and a (very small) - face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ - -#define GLYPH_CODE_P(gc) \ - (CONSP (gc) \ - ? (CHARACTERP (XCAR (gc)) \ - && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ - : (RANGED_INTEGERP \ - (0, gc, \ - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ - ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ - : TYPE_MAXIMUM (EMACS_INT))))) - -/* The following are valid only if GLYPH_CODE_P (gc). */ - -#define GLYPH_CODE_CHAR(gc) \ - (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) - -#define GLYPH_CODE_FACE(gc) \ - (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) - -#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ - do \ - { \ - if (CONSP (gc)) \ - SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ - else \ - SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ - (XINT (gc) >> CHARACTERBITS)); \ - } \ - while (0) \f /* Structure to hold mouse highlight data. This is here because other header files need it for defining struct x_output etc. */ @@ -1768,190 +2203,235 @@ \f /* Data type checking. */ -#define NILP(x) EQ (x, Qnil) - -#define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) - -#define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) +LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x)) + +LISP_INLINE bool +NUMBERP (Lisp_Object x) +{ + return INTEGERP (x) || FLOATP (x); +} +LISP_INLINE bool +NATNUMP (Lisp_Object x) +{ + return INTEGERP (x) && 0 <= XINT (x); +} + +LISP_INLINE bool +RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +{ + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; +} + #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - -#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) -#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - -#define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) -#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) - + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + +LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x)) + +LISP_INLINE bool +STRINGP (Lisp_Object x) +{ + return XTYPE (x) == Lisp_String; +} +LISP_INLINE bool +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} +LISP_INLINE bool +OVERLAYP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; +} LISP_INLINE bool SAVE_VALUEP (Lisp_Object x) { return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; } -LISP_INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; -} - -/* Return the type of V's Nth saved value. */ -LISP_INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -LISP_INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer;; -} -LISP_INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} - -/* Likewise for the saved integer. */ - -LISP_INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -LISP_INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -LISP_INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - -#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) - -#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) -#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) -#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) -#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) -#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - -/* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ -#define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) - -#define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) - -/* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ -#define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) +LISP_INLINE bool +AUTOLOADP (Lisp_Object x) +{ + return CONSP (x) && EQ (Qautoload, XCAR (x)); +} + +LISP_INLINE bool +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} + +LISP_INLINE bool +PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) +{ + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +LISP_INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } +} + /* Test for specific pseudovector types. */ -#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) -#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) + +LISP_INLINE bool +WINDOW_CONFIGURATIONP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); +} + +LISP_INLINE bool +PROCESSP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_PROCESS); +} + +LISP_INLINE bool +WINDOWP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WINDOW); +} + +LISP_INLINE bool +TERMINALP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TERMINAL); +} + +LISP_INLINE bool +SUBRP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUBR); +} + +LISP_INLINE bool +COMPILEDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_COMPILED); +} + +LISP_INLINE bool +BUFFERP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BUFFER); +} + +LISP_INLINE bool +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +LISP_INLINE bool +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); +} + +LISP_INLINE bool +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +LISP_INLINE bool +FRAMEP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_FRAME); +} /* Test for image (image . spec) */ -#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +LISP_INLINE bool +IMAGEP (Lisp_Object x) +{ + return CONSP (x) && EQ (XCAR (x), Qimage); +} /* Array types. */ - -#define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) +LISP_INLINE bool +ARRAYP (Lisp_Object x) +{ + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); +} \f -#define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - -#define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - -#define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - -#define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - -#define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - -#define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - -#define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - -#define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - -#define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - -#define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - -#define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - -#define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - -#define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - -#define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - -#define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - -#define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) - -#define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) - -#define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) +LISP_INLINE void +CHECK_LIST (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); +} + +LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y)) +LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x)) +LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x)) + +LISP_INLINE void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} +LISP_INLINE void +CHECK_STRING_CAR (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); +} +LISP_INLINE void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} +LISP_INLINE void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} +LISP_INLINE void +CHECK_VECTOR_OR_STRING (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); +} +LISP_INLINE void +CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +{ + CHECK_TYPE (ARRAYP (x), Qxxxp, x); +} +LISP_INLINE void +CHECK_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (BUFFERP (x), Qbufferp, x); +} +LISP_INLINE void +CHECK_WINDOW (Lisp_Object x) +{ + CHECK_TYPE (WINDOWP (x), Qwindowp, x); +} +LISP_INLINE void +CHECK_PROCESS (Lisp_Object x) +{ + CHECK_TYPE (PROCESSP (x), Qprocessp, x); +} +LISP_INLINE void +CHECK_NATNUM (Lisp_Object x) +{ + CHECK_TYPE (NATNUMP (x), Qwholenump, x); +} #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@ -1972,57 +2452,43 @@ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (0) -#define CHECK_MARKER(x) \ - CHECK_TYPE (MARKERP (x), Qmarkerp, x) - #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) -#define XFLOATINT(n) extract_float((n)) - -#define CHECK_FLOAT(x) \ - CHECK_TYPE (FLOATP (x), Qfloatp, x) - -#define CHECK_NUMBER_OR_FLOAT(x) \ - CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) +LISP_INLINE double +XFLOATINT (Lisp_Object n) +{ + return extract_float (n); +} + +LISP_INLINE void +CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +{ + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); +} #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) -#define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) - /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ -#define CHECK_NUMBER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - -#define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) +LISP_INLINE void +CHECK_NUMBER_CAR (Lisp_Object x) +{ + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); +} + +LISP_INLINE void +CHECK_NUMBER_CDR (Lisp_Object x) +{ + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); +} \f /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2088,8 +2554,12 @@ #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) -/* Non-zero if OBJ is a Lisp function. */ -#define FUNCTIONP(OBJ) functionp(OBJ) +/* True if OBJ is a Lisp function. */ +LISP_INLINE bool +FUNCTIONP (Lisp_Object obj) +{ + return functionp (obj); +} /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ @@ -2245,38 +2715,15 @@ } v; }; -LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) -{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } - -LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl) -{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; } - -LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl) -{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; } - -LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; } - -LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; } - -LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; } - -LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; } - -LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; } - -LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl) -{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; } - extern struct specbinding *specpdl; extern struct specbinding *specpdl_ptr; extern ptrdiff_t specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +LISP_INLINE ptrdiff_t +SPECPDL_INDEX (void) +{ + return specpdl_ptr - specpdl; +} /* Everything needed to describe an active condition case. @@ -2592,27 +3039,12 @@ #define EXFUN(fnname, maxargs) \ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs +#include "globals.h" + /* Forward declarations for prototypes. */ struct window; struct frame; -/* Simple access functions. */ - -LISP_INLINE Lisp_Object * -aref_addr (Lisp_Object array, ptrdiff_t idx) -{ - return & XVECTOR (array)->contents[idx]; -} - -LISP_INLINE void -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)); - XVECTOR (array)->contents[idx] = val; -} - /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ LISP_INLINE void @@ -2625,12 +3057,6 @@ /* Functions to modify hash tables. */ LISP_INLINE void -set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) -{ - h->key_and_value = key_and_value; -} - -LISP_INLINE void set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { gc_aset (h->key_and_value, 2 * idx, val); @@ -2642,52 +3068,10 @@ gc_aset (h->key_and_value, 2 * idx + 1, val); } -LISP_INLINE void -set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) -{ - h->next = next; -} - -LISP_INLINE void -set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->next, idx, val); -} - -LISP_INLINE void -set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) -{ - h->hash = hash; -} - -LISP_INLINE void -set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->hash, idx, val); -} - -LISP_INLINE void -set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) -{ - h->index = index; -} - -LISP_INLINE void -set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) -{ - gc_aset (h->index, idx, val); -} - /* Use these functions to set Lisp_Object or pointer slots of struct Lisp_Symbol. */ LISP_INLINE void -set_symbol_name (Lisp_Object sym, Lisp_Object name) -{ - XSYMBOL (sym)->name = name; -} - -LISP_INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { XSYMBOL (sym)->function = function; @@ -2714,43 +3098,6 @@ return blv->found; } -LISP_INLINE void -set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) -{ - eassert (found == !EQ (blv->defcell, blv->valcell)); - blv->found = found; -} - -LISP_INLINE Lisp_Object -blv_value (struct Lisp_Buffer_Local_Value *blv) -{ - return XCDR (blv->valcell); -} - -LISP_INLINE void -set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - XSETCDR (blv->valcell, val); -} - -LISP_INLINE void -set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->where = val; -} - -LISP_INLINE void -set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->defcell = val; -} - -LISP_INLINE void -set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) -{ - blv->valcell = val; -} - /* Set overlay's property list. */ LISP_INLINE void @@ -2779,21 +3126,11 @@ of setting slots directly. */ LISP_INLINE void -set_char_table_ascii (Lisp_Object table, Lisp_Object val) -{ - XCHAR_TABLE (table)->ascii = val; -} -LISP_INLINE void set_char_table_defalt (Lisp_Object table, Lisp_Object val) { XCHAR_TABLE (table)->defalt = val; } LISP_INLINE void -set_char_table_parent (Lisp_Object table, Lisp_Object val) -{ - XCHAR_TABLE (table)->parent = val; -} -LISP_INLINE void set_char_table_purpose (Lisp_Object table, Lisp_Object val) { XCHAR_TABLE (table)->purpose = val; @@ -3237,7 +3574,7 @@ #ifdef GC_CHECK_CONS_LIST extern void check_cons_list (void); #else -#define check_cons_list() ((void) 0) +LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } #endif #ifdef REL_ALLOC @@ -3305,10 +3642,12 @@ extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); -#define LOADHIST_ATTACH(x) \ - do { \ - if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ - } while (0) +LISP_INLINE void +LOADHIST_ATTACH (Lisp_Object x) +{ + if (initialized) + Vcurrent_load_list = Fcons (x, Vcurrent_load_list); +} extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object); extern Lisp_Object string_to_number (char const *, int, bool); @@ -3594,10 +3933,9 @@ void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); #else -#define setlocale(category, locale) -#define fixup_locale() -#define synchronize_system_messages_locale() -#define synchronize_system_time_locale() +LISP_INLINE void fixup_locale (void) {} +LISP_INLINE void synchronize_system_messages_locale (void) {} +LISP_INLINE void synchronize_system_time_locale (void) {} #endif extern void shut_down_emacs (int, Lisp_Object); @@ -3956,8 +4294,6 @@ } while (0) -#include "globals.h" - /* Check whether it's time for GC, and run it if so. */ LISP_INLINE void @@ -3970,7 +4306,7 @@ Fgarbage_collect (); } -LISP_INLINE int +LISP_INLINE bool functionp (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) === modified file 'src/marker.c' --- src/marker.c 2013-02-19 14:44:03 +0000 +++ src/marker.c 2013-06-13 15:38:16 +0000 @@ -127,6 +127,12 @@ } \ } +static void +CHECK_MARKER (Lisp_Object x) +{ + CHECK_TYPE (MARKERP (x), Qmarkerp, x); +} + /* Return the byte position corresponding to CHARPOS in B. */ ptrdiff_t === modified file 'src/textprop.c' --- src/textprop.c 2013-03-28 14:04:49 +0000 +++ src/textprop.c 2013-06-13 15:38:16 +0000 @@ -98,6 +98,14 @@ set_buffer_internal (old); } +/* Complain if object is not string or buffer type. */ + +static void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} + /* Extract the interval at the position pointed to by BEGIN from OBJECT, a string or buffer. Additionally, check that the positions pointed to by BEGIN and END are within the bounds of OBJECT, and === modified file 'src/window.c' --- src/window.c 2013-06-04 16:33:46 +0000 +++ src/window.c 2013-06-13 16:02:24 +0000 @@ -55,7 +55,8 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_valid_p; -static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; +static Lisp_Object Qwindow_configuration_p; +static Lisp_Object Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; @@ -130,6 +131,12 @@ static EMACS_INT window_scroll_preserve_hpos; static EMACS_INT window_scroll_preserve_vpos; \f +static void +CHECK_WINDOW_CONFIGURATION (Lisp_Object x) +{ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); +} + /* These setters are used only in this file, so they can be private. */ static void wset_combination_limit (struct window *w, Lisp_Object val) === modified file 'src/window.h' --- src/window.h 2013-03-28 14:04:49 +0000 +++ src/window.h 2013-06-13 15:38:03 +0000 @@ -958,7 +958,7 @@ /* These used to be in lisp.h. */ -extern Lisp_Object Qwindowp, Qwindow_live_p; +extern Lisp_Object Qwindow_live_p; extern Lisp_Object Vwindow_list; extern struct window *decode_live_window (Lisp_Object); ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-15 6:43 ` Paul Eggert @ 2013-06-15 14:22 ` Stefan Monnier 2013-06-17 6:05 ` Paul Eggert 0 siblings, 1 reply; 41+ messages in thread From: Stefan Monnier @ 2013-06-15 14:22 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 > The following variant works for me, and the attached combined > patch implements this suggestion. Looks OK to me, thank you, Stefan ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-15 14:22 ` Stefan Monnier @ 2013-06-17 6:05 ` Paul Eggert 0 siblings, 0 replies; 41+ messages in thread From: Paul Eggert @ 2013-06-17 6:05 UTC (permalink / raw) To: Stefan Monnier; +Cc: 11935-done On 06/15/2013 07:22 AM, Stefan Monnier wrote: > Looks OK to me, thank you, OK, I installed that as trunk bzr 113012 and am marking this as done. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 0:52 ` Paul Eggert 2013-06-09 3:04 ` Stefan Monnier @ 2013-06-09 6:56 ` Jan Djärv 2013-06-09 7:23 ` Paul Eggert 1 sibling, 1 reply; 41+ messages in thread From: Jan Djärv @ 2013-06-09 6:56 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 Hello. 9 jun 2013 kl. 02:52 skrev Paul Eggert <eggert@cs.ucla.edu>: > On 06/06/13 09:42, Stefan Monnier wrote: > >> Having XCONS and friends duplicated into a macro version and a function >> version is a non-starter for me. > > Yes, I didn't like those macros either. I'll remove them; they're no > longer needed now that GCC has the -Og option. In case you haven't > run into it yet, -Og means "optimize for debugging", and causes GCC to > generate code that's easy to debug, without having the big runtime > performance penalty of -O0. Which version of gcc has this? Note that most people does not have the latest gcc version. Jan D. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 6:56 ` Jan Djärv @ 2013-06-09 7:23 ` Paul Eggert 2013-06-09 9:18 ` Jan Djärv 0 siblings, 1 reply; 41+ messages in thread From: Paul Eggert @ 2013-06-09 7:23 UTC (permalink / raw) To: Jan Djärv; +Cc: 11935 On 06/08/2013 11:56 PM, Jan Djärv wrote: > most people does not have the latest gcc version. Most people can use older GCC versions just fine, since by default Emacs builds with optimization flags that will generate pretty much the same machine code regardless of whether the patch is used. The only problem is with developers who are using older GCC versions and who wish to compile without optimization, to make Emacs easier to debug. These folks can't use -Og (available in GCC 4.8 and later), so they have to make do with -O0. -Og is better for debugging than -O0 is, and the proposed patch caters to -Og. Eventually the -Og approach will win out; the only question is when and how to start the ball rolling. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 7:23 ` Paul Eggert @ 2013-06-09 9:18 ` Jan Djärv 2013-06-09 14:25 ` Juanma Barranquero 0 siblings, 1 reply; 41+ messages in thread From: Jan Djärv @ 2013-06-09 9:18 UTC (permalink / raw) To: Paul Eggert; +Cc: 11935 Hello. 9 jun 2013 kl. 09:23 skrev Paul Eggert <eggert@cs.ucla.edu>: > On 06/08/2013 11:56 PM, Jan Djärv wrote: >> most people does not have the latest gcc version. > > Most people can use older GCC versions just fine, > since by default Emacs builds with optimization flags > that will generate pretty much the same machine code > regardless of whether the patch is used. > > The only problem is with developers who are using older > GCC versions and who wish to compile without optimization, > to make Emacs easier to debug. These folks can't use -Og > (available in GCC 4.8 and later), so they have to make do > with -O0. > That is not the only problem. etc/DEBUG recommends to build with no optimization when reporting errors. > -Og is better for debugging than -O0 is, and the > proposed patch caters to -Og. Eventually the -Og > approach will win out; the only question is when > and how to start the ball rolling. If you can make it detect when to use macros and when to use functions so -O0 doesn't suffer, that is starting the ball rolling. Otherwise it is setting up a brick wall for users/developers with older gcc. Jan D. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 9:18 ` Jan Djärv @ 2013-06-09 14:25 ` Juanma Barranquero 2013-06-09 16:05 ` Jan Djärv 0 siblings, 1 reply; 41+ messages in thread From: Juanma Barranquero @ 2013-06-09 14:25 UTC (permalink / raw) To: Jan Djärv; +Cc: 11935, Paul Eggert On Sun, Jun 9, 2013 at 11:18 AM, Jan Djärv <jan.h.d@swipnet.se> wrote: > If you can make it detect when to use macros and when to use functions so > -O0 doesn't suffer, that is starting the ball rolling. Otherwise it is setting up > a brick wall for users/developers with older gcc. Also, in some environments updating to newer GCC isn't that easy. There's no MinGW GCC 4.8.1, and I wouldn't bet there will be one for many months. J ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2013-06-09 14:25 ` Juanma Barranquero @ 2013-06-09 16:05 ` Jan Djärv 0 siblings, 0 replies; 41+ messages in thread From: Jan Djärv @ 2013-06-09 16:05 UTC (permalink / raw) To: Juanma Barranquero; +Cc: 11935, Paul Eggert Hello. 9 jun 2013 kl. 16:25 skrev Juanma Barranquero <lekktu@gmail.com>: > On Sun, Jun 9, 2013 at 11:18 AM, Jan Djärv <jan.h.d@swipnet.se> wrote: > >> If you can make it detect when to use macros and when to use functions so >> -O0 doesn't suffer, that is starting the ball rolling. Otherwise it is setting up >> a brick wall for users/developers with older gcc. > > Also, in some environments updating to newer GCC isn't that easy. > There's no MinGW GCC 4.8.1, and I wouldn't bet there will be one for > many months. Another thing to consider are other compilers. Clang is becoming more common, and is available on all supported platforms (maybe not DOS). How does it handle -g -O0? AFAIK, it does not have -Og. Jan D. ^ permalink raw reply [flat|nested] 41+ messages in thread
* bug#11935: XINT etc. should be functions 2012-07-13 15:07 bug#11935: XINT etc. should be functions Paul Eggert ` (2 preceding siblings ...) 2013-06-06 15:56 ` Paul Eggert @ 2013-06-10 13:40 ` Barry OReilly 3 siblings, 0 replies; 41+ messages in thread From: Barry OReilly @ 2013-06-10 13:40 UTC (permalink / raw) To: 11935 [-- Attachment #1: Type: text/plain, Size: 263 bytes --] Man gcc indicates -O* flags are selected sets of finer grained optimizations. Perhaps if this is so for -Og, it is possible to build an efficient and debug-friendly Emacs with older versions of GCC by specifying the right set of finer grained optimization flags. [-- Attachment #2: Type: text/html, Size: 274 bytes --] ^ permalink raw reply [flat|nested] 41+ messages in thread
end of thread, other threads:[~2013-06-17 6:05 UTC | newest] Thread overview: 41+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2012-07-13 15:07 bug#11935: XINT etc. should be functions Paul Eggert 2012-07-14 2:20 ` bug#11935: [TRUNCATED MESSAGE 2746 87596] " Richard Stallman 2012-07-15 13:41 ` Paul Eggert 2012-07-15 22:06 ` Stefan Monnier 2012-07-16 14:54 ` Paul Eggert 2012-07-16 16:12 ` Eli Zaretskii 2012-07-16 21:40 ` Paul Eggert 2012-07-16 18:19 ` Richard Stallman 2012-07-16 22:46 ` Paul Eggert 2012-07-17 3:04 ` Eli Zaretskii 2012-07-17 3:54 ` Paul Eggert 2012-07-24 2:20 ` Paul Eggert 2012-07-24 9:07 ` Stefan Monnier 2012-07-24 13:45 ` Paul Eggert 2012-07-24 21:57 ` Stefan Monnier 2012-07-25 4:07 ` Paul Eggert 2012-07-15 14:41 ` Chong Yidong 2012-07-15 16:40 ` Paul Eggert 2012-07-16 2:22 ` Chong Yidong 2012-07-16 14:54 ` Paul Eggert 2013-06-06 15:56 ` Paul Eggert 2013-06-06 16:36 ` Andreas Schwab 2013-06-13 16:30 ` Paul Eggert 2013-06-06 16:42 ` Stefan Monnier 2013-06-09 0:52 ` Paul Eggert 2013-06-09 3:04 ` Stefan Monnier 2013-06-09 4:37 ` James Cloos 2013-06-09 6:59 ` Jan Djärv 2013-06-09 7:13 ` Paul Eggert 2013-06-09 15:57 ` Stefan Monnier 2013-06-13 14:45 ` Paul Eggert 2013-06-13 20:08 ` Stefan Monnier 2013-06-15 6:43 ` Paul Eggert 2013-06-15 14:22 ` Stefan Monnier 2013-06-17 6:05 ` Paul Eggert 2013-06-09 6:56 ` Jan Djärv 2013-06-09 7:23 ` Paul Eggert 2013-06-09 9:18 ` Jan Djärv 2013-06-09 14:25 ` Juanma Barranquero 2013-06-09 16:05 ` Jan Djärv 2013-06-10 13:40 ` Barry OReilly
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).