diff options
| author | Paul Eggert | 2013-06-16 23:03:19 -0700 |
|---|---|---|
| committer | Paul Eggert | 2013-06-16 23:03:19 -0700 |
| commit | 84575e67fc390815f8f9fc8bea095e006f0890c4 (patch) | |
| tree | a3285603fbe57ecfd7c12b1cfef0f1b431530965 /src | |
| parent | f612933b88509427a690ea1966eac533b8ef80e1 (diff) | |
| download | emacs-84575e67fc390815f8f9fc8bea095e006f0890c4.tar.gz emacs-84575e67fc390815f8f9fc8bea095e006f0890c4.zip | |
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:
. 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.
Also, 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.
* configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast,
as it generates bogus warnings about reasonable casts of calls.
* 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.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 161 | ||||
| -rw-r--r-- | src/alloc.c | 20 | ||||
| -rw-r--r-- | src/buffer.c | 8 | ||||
| -rw-r--r-- | src/chartab.c | 16 | ||||
| -rw-r--r-- | src/coding.c | 16 | ||||
| -rw-r--r-- | src/data.c | 91 | ||||
| -rw-r--r-- | src/dispextern.h | 75 | ||||
| -rw-r--r-- | src/emacs.c | 7 | ||||
| -rw-r--r-- | src/eval.c | 63 | ||||
| -rw-r--r-- | src/floatfns.c | 8 | ||||
| -rw-r--r-- | src/fns.c | 51 | ||||
| -rw-r--r-- | src/keymap.c | 6 | ||||
| -rw-r--r-- | src/lisp.h | 1722 | ||||
| -rw-r--r-- | src/marker.c | 6 | ||||
| -rw-r--r-- | src/textprop.c | 8 | ||||
| -rw-r--r-- | src/window.c | 9 | ||||
| -rw-r--r-- | src/window.h | 2 |
17 files changed, 1565 insertions, 704 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a26577c20a3..fc57bdaba26 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,164 @@ | |||
| 1 | 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Move functions from lisp.h to individual modules when possible. | ||
| 4 | From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>. | ||
| 5 | * alloc.c (XFLOAT_INIT, set_symbol_name): | ||
| 6 | * buffer.c (CHECK_OVERLAY): | ||
| 7 | * chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii) | ||
| 8 | (set_char_table_parent): | ||
| 9 | * coding.c (CHECK_NATNUM_CAR, CHECK_NATNUM_CDR): | ||
| 10 | * data.c (BOOLFWDP, INTFWDP, KBOARD_OBJFWDP, OBJFWDP, XBOOLFWD) | ||
| 11 | (XKBOARD_OBJFWD, XINTFWD, XOBJFWD, CHECK_SUBR, set_blv_found) | ||
| 12 | (blv_value, set_blv_value, set_blv_where, set_blv_defcell) | ||
| 13 | (set_blv_valcell): | ||
| 14 | * emacs.c (setlocale) [!HAVE_SETLOCALE]: | ||
| 15 | * eval.c (specpdl_symbol, specpdl_old_value, specpdl_where) | ||
| 16 | (specpdl_arg, specpdl_func, backtrace_function, backtrace_nargs) | ||
| 17 | (backtrace_args, backtrace_debug_on_exit): | ||
| 18 | * floatfns.c (CHECK_FLOAT): | ||
| 19 | * fns.c (CHECK_HASH_TABLE, CHECK_LIST_END) | ||
| 20 | (set_hash_key_and_value, set_hash_next, set_hash_next_slot) | ||
| 21 | (set_hash_hash, set_hash_hash_slot, set_hash_index) | ||
| 22 | (set_hash_index_slot): | ||
| 23 | * keymap.c (CHECK_VECTOR_OR_CHAR_TABLE): | ||
| 24 | * marker.c (CHECK_MARKER): | ||
| 25 | * textprop.c (CHECK_STRING_OR_BUFFER): | ||
| 26 | * window.c (CHECK_WINDOW_CONFIGURATION): | ||
| 27 | Move here from lisp.h, and make these functions static rather than | ||
| 28 | extern inline. | ||
| 29 | * buffer.c (Qoverlayp): | ||
| 30 | * data.c (Qsubrp): | ||
| 31 | * fns.c (Qhash_table_p): | ||
| 32 | * window.c (Qwindow_configuration_p): | ||
| 33 | Now static. | ||
| 34 | * lisp.h: Remove the abovementioned defns and decls. | ||
| 35 | |||
| 36 | Use functions, not macros, for XINT etc. (Bug#11935). | ||
| 37 | In lisp.h, prefer functions to function-like macros, and | ||
| 38 | constants to object-like macros, when either will do. This: | ||
| 39 | . simplifies use, as there's no more need to worry about | ||
| 40 | arguments' side effects being evaluated multiple times. | ||
| 41 | . makes the code easier to debug on some platforms. | ||
| 42 | However, when using gcc -O0, keep using function-like macros | ||
| 43 | for a few critical operations, for performance reasons. | ||
| 44 | This sort of thing isn't needed with gcc -Og, but -Og | ||
| 45 | is a GCC 4.8 feature and isn't widely-enough available yet. | ||
| 46 | * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: | ||
| 47 | Remove enum lsb_bits; no longer needed. | ||
| 48 | (allocate_misc, free_misc): Don't use XMISCTYPE as an lvalue. | ||
| 49 | * buffer.c (Qoverlap): | ||
| 50 | * data.c (Qsubrp): | ||
| 51 | * fns.c (Qhash_table_p): | ||
| 52 | Now extern, so lisp.h can use these symbols. | ||
| 53 | * dispextern.h: Include character.h, for MAX_CHAR etc. | ||
| 54 | (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) | ||
| 55 | (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) | ||
| 56 | (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) | ||
| 57 | (GLYPH_CODE_P): Move here from lisp.h. | ||
| 58 | (GLYPH_CHAR, GLYPH_FACE, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) | ||
| 59 | (GLYPH_CHAR_VALID_P, GLYPH_CODE_P): Now functions, not macros. | ||
| 60 | (GLYPH_MODE_LINE_FACE): Now enums, not macros. | ||
| 61 | * eval.c (Fautoload): Cast XUNTAG output to intptr_t, since | ||
| 62 | XUNTAG now returns void *. | ||
| 63 | * lisp.h (lisp_h_XLI, lisp_h_XIL, lisp_h_CHECK_LIST_CONS) | ||
| 64 | (lisp_h_CHECK_NUMBER CHECK_SYMBOL, lisp_h_CHECK_TYPE) | ||
| 65 | (lisp_h_CONSP, lisp_h_EQ, lisp_h_FLOATP, lisp_h_INTEGERP) | ||
| 66 | (lisp_h_MARKERP, lisp_h_MISCP, lisp_h_NILP) | ||
| 67 | (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_CONSTANT_P) | ||
| 68 | (lisp_h_SYMBOL_VAL, lisp_h_SYMBOLP, lisp_h_VECTORLIKEP) | ||
| 69 | (lisp_h_XCAR, lisp_h_XCDR, lisp_h_XCONS, lisp_h_XHASH) | ||
| 70 | (lisp_h_XPNTR, lisp_h_XSYMBOL): | ||
| 71 | New macros, renamed from their sans-lisp_h_ counterparts. | ||
| 72 | (XLI, XIL, CHECK_LIST_CONS, CHECK_NUMBER CHECK_SYMBOL) | ||
| 73 | (CHECK_TYPE, CONSP, EQ, FLOATP, INTEGERP, MARKERP) | ||
| 74 | (MISCP, NILP, SET_SYMBOL_VAL, SYMBOL_CONSTANT_P, SYMBOL_VAL, SYMBOLP) | ||
| 75 | (VECTORLIKEP, XCAR, XCDR, XCONS, XHASH, XPNTR, XSYMBOL): | ||
| 76 | If compiling via GCC without optimization, define these as macros | ||
| 77 | in addition to inline functions. | ||
| 78 | To disable this, compile with -DINLINING=0. | ||
| 79 | (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): New macros. | ||
| 80 | (check_cons_list) [!GC_CHECK_CONS_LIST]: Likewise. | ||
| 81 | (make_number, XFASTINT, XINT, XTYPE, XUNTAG): Likewise, but | ||
| 82 | hand-optimize only in the USE_LSB_TAG case, as GNUish hosts do that. | ||
| 83 | (INTMASK, VALMASK): Now macros, since static values cannot be | ||
| 84 | accessed from extern inline functions. | ||
| 85 | (VALMASK): Also a constant, for benefit of old GDB. | ||
| 86 | (LISP_INT_TAG_P): Remove; no longer needed as the only caller | ||
| 87 | is INTEGERP, which can fold it in. | ||
| 88 | (XLI, XIL, XHASH, XTYPE,XINT, XFASTINT, XUINT) | ||
| 89 | (make_number, XPNTR, XUNTAG, EQ, XCONS, XVECTOR, XSTRING, XSYMBOL) | ||
| 90 | (XFLOAT, XPROCESS, XWINDOW, XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE) | ||
| 91 | (XSUB_CHAR_TABLE, XBOOL_VECTOR, make_lisp_ptr, CHECK_TYPE) | ||
| 92 | (CHECK_STRING_OR_BUFFER, XCAR, XCDR, XSETCAR, XSETCDR, CAR, CDR) | ||
| 93 | (CAR_SAFE, CDR_SAFE, STRING_MULTIBYTE, SDATA, SSDATA, SREF, SSET) | ||
| 94 | (SCHARS, STRING_BYTES, SBYTES, STRING_SET_CHARS, STRING_COPYIN, AREF) | ||
| 95 | (ASIZE, ASET, CHAR_TABLE_REF_ASCII, CHAR_TABLE_REF) | ||
| 96 | (CHAR_TABLE_SET, CHAR_TABLE_EXTRA_SLOTS, SYMBOL_VAL, SYMBOL_ALIAS) | ||
| 97 | (SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL, SET_SYMBOL_ALIAS) | ||
| 98 | (SET_SYMBOL_BLV, SET_SYMBOL_FWD, SYMBOL_NAME, SYMBOL_INTERNED_P) | ||
| 99 | (SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P, SYMBOL_CONSTANT_P) | ||
| 100 | (XHASH_TABLE, HASH_TABLE_P, CHECK_HASH_TABLE, HASH_KEY, HASH_VALUE) | ||
| 101 | (HASH_NEXT, HASH_HASH, HASH_INDEX, HASH_TABLE_SIZE) | ||
| 102 | (XMISC, XMISCANY, XMARKER, XOVERLAY, XSAVE_VALUE, XFWDTYPE) | ||
| 103 | (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD, XKBOARD_OBJFWD) | ||
| 104 | (XFLOAT_DATA, XFLOAT_INIT, NILP, NUMBERP, NATNUMP) | ||
| 105 | (RANGED_INTEGERP, CONSP, FLOATP, MISCP, STRINGP, SYMBOLP) | ||
| 106 | (INTEGERP, VECTORLIKEP, VECTORP, OVERLAYP) | ||
| 107 | (MARKERP, SAVE_VALUEP, AUTOLOADP, INTFWDP, BOOLFWDP, OBJFWDP) | ||
| 108 | (BUFFER_OBJFWDP, KBOARD_OBJFWDP, PSEUDOVECTOR_TYPEP) | ||
| 109 | (PSEUDOVECTORP, WINDOW_CONFIGURATIONP, PROCESSP, WINDOWP) | ||
| 110 | (TERMINALP, SUBRP, COMPILEDP, BUFFERP, CHAR_TABLE_P) | ||
| 111 | (SUB_CHAR_TABLE_P, BOOL_VECTOR_P, FRAMEP, IMAGEP, ARRAYP) | ||
| 112 | (CHECK_LIST, CHECK_LIST_CONS, CHECK_LIST_END, CHECK_STRING) | ||
| 113 | (CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL, CHECK_CHAR_TABLE) | ||
| 114 | (CHECK_VECTOR, CHECK_VECTOR_OR_STRING, CHECK_ARRAY) | ||
| 115 | (CHECK_VECTOR_OR_CHAR_TABLE, CHECK_BUFFER, CHECK_WINDOW) | ||
| 116 | (CHECK_WINDOW_CONFIGURATION, CHECK_PROCESS, CHECK_SUBR) | ||
| 117 | (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, XFLOATINT) | ||
| 118 | (CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_OVERLAY) | ||
| 119 | (CHECK_NUMBER_CAR, CHECK_NUMBER_CDR, CHECK_NATNUM_CAR) | ||
| 120 | (CHECK_NATNUM_CDR, FUNCTIONP, SPECPDL_INDEX, LOADHIST_ATTACH) | ||
| 121 | Now functions. | ||
| 122 | (check_cons_list) [!GC_CHECK_CONS_LIST]: New empty function. | ||
| 123 | (LISP_MAKE_RVALUE, TYPEMASK): Remove; no longer needed. | ||
| 124 | (VALMASK): Define in one place rather than in two, merging the | ||
| 125 | USE_LSB_TAG parts; this is simpler. | ||
| 126 | (aref_addr, gc_aset, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM) | ||
| 127 | (max, min, struct Lisp_String, UNSIGNED_CMP, ASCII_CHAR_P): | ||
| 128 | Move up, to avoid use before definition. | ||
| 129 | Also include "globals.h" earlier, for the same reason. | ||
| 130 | (make_natnum): New function. | ||
| 131 | (XUNTAG): Now returns void *, not intptr_t, as this means fewer casts. | ||
| 132 | (union Lisp_Fwd, BOOLFWDP, BOOL_VECTOR_P, BUFFER_OBJFWDP, BUFFERP) | ||
| 133 | (CHAR_TABLE_P, CHAR_TABLE_REF_ASCII, CONSP, FLOATP, INTEGERP, INTFWDP) | ||
| 134 | (KBOARD_OBJFWDP, MARKERP, MISCP, NILP, OBJFWDP, OVERLAYP, PROCESSP) | ||
| 135 | (PSEUDOVECTORP, SAVE_VALUEP, STRINGP, SUB_CHAR_TABLE_P, SUBRP, SYMBOLP) | ||
| 136 | (VECTORLIKEP, WINDOWP, Qoverlayp, char_table_ref, char_table_set) | ||
| 137 | (char_table_translate, Qarrayp, Qbufferp, Qbuffer_or_string_p) | ||
| 138 | (Qchar_table_p, Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp) | ||
| 139 | (Qnil, Qnumberp, Qsubrp, Qstringp, Qsymbolp, Qvectorp) | ||
| 140 | (Qvector_or_char_table_p, Qwholenump, Ffboundp, wrong_type_argument) | ||
| 141 | (initialized, Qhash_table_p, extract_float, Qprocessp, Qwindowp) | ||
| 142 | (Qwindow_configuration_p, Qimage): New forward declarations. | ||
| 143 | (XSETFASTINT): Simplify by rewriting in terms of make_natnum. | ||
| 144 | (STRING_COPYIN): Remove; unused. | ||
| 145 | (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove these macros, replacing with ... | ||
| 146 | (xcar_addr, xcdr_addr): New functions. All uses changed. | ||
| 147 | (IEEE_FLOATING_POINT): Now a constant, not a macro. | ||
| 148 | (GLYPH, GLYPH_CHAR, GLYPH_FACE, SET_GLYPH_CHAR, SET_GLYPH_FACE) | ||
| 149 | (SET_GLYPH, GLYPH_CODE_CHAR, GLYPH_CODE_FACE) | ||
| 150 | (SET_GLYPH_FROM_GLYPH_CODE, GLYPH_MODE_LINE_FACE, GLYPH_CHAR_VALID_P) | ||
| 151 | (GLYPH_CODE_P): Move to dispextern.h, to avoid define-before-use. | ||
| 152 | (TYPE_RANGED_INTEGERP): Simplify. | ||
| 153 | (Qsubrp, Qhash_table_p, Qoverlayp): New extern decls. | ||
| 154 | (setlocale, fixup_locale, synchronize_system_messages_locale) | ||
| 155 | (synchronize_system_time_locale) [!HAVE_SETLOCALE]: | ||
| 156 | Now empty functions, not macros. | ||
| 157 | (functionp): Return bool, not int. | ||
| 158 | * window.c (Qwindow_configuration_p): Now extern, | ||
| 159 | so window.h can use it. | ||
| 160 | * window.h (Qwindowp): Move decl back to lisp.h. | ||
| 161 | |||
| 1 | 2013-06-15 Eli Zaretskii <eliz@gnu.org> | 162 | 2013-06-15 Eli Zaretskii <eliz@gnu.org> |
| 2 | 163 | ||
| 3 | * xdisp.c (Fline_pixel_height): New function, required for solving | 164 | * xdisp.c (Fline_pixel_height): New function, required for solving |
diff --git a/src/alloc.c b/src/alloc.c index cce0fff4fd4..3eb7e982e0f 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -363,6 +363,11 @@ static void *pure_alloc (size_t, int); | |||
| 363 | ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ | 363 | ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ |
| 364 | & ~ ((ALIGNMENT) - 1))) | 364 | & ~ ((ALIGNMENT) - 1))) |
| 365 | 365 | ||
| 366 | static void | ||
| 367 | XFLOAT_INIT (Lisp_Object f, double n) | ||
| 368 | { | ||
| 369 | XFLOAT (f)->u.data = n; | ||
| 370 | } | ||
| 366 | 371 | ||
| 367 | 372 | ||
| 368 | /************************************************************************ | 373 | /************************************************************************ |
| @@ -3189,6 +3194,12 @@ static int symbol_block_index = SYMBOL_BLOCK_SIZE; | |||
| 3189 | 3194 | ||
| 3190 | static struct Lisp_Symbol *symbol_free_list; | 3195 | static struct Lisp_Symbol *symbol_free_list; |
| 3191 | 3196 | ||
| 3197 | static void | ||
| 3198 | set_symbol_name (Lisp_Object sym, Lisp_Object name) | ||
| 3199 | { | ||
| 3200 | XSYMBOL (sym)->name = name; | ||
| 3201 | } | ||
| 3202 | |||
| 3192 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, | 3203 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, |
| 3193 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. | 3204 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. |
| 3194 | Its value is void, and its function definition and property list are nil. */) | 3205 | Its value is void, and its function definition and property list are nil. */) |
| @@ -3309,7 +3320,7 @@ allocate_misc (enum Lisp_Misc_Type type) | |||
| 3309 | --total_free_markers; | 3320 | --total_free_markers; |
| 3310 | consing_since_gc += sizeof (union Lisp_Misc); | 3321 | consing_since_gc += sizeof (union Lisp_Misc); |
| 3311 | misc_objects_consed++; | 3322 | misc_objects_consed++; |
| 3312 | XMISCTYPE (val) = type; | 3323 | XMISCANY (val)->type = type; |
| 3313 | XMISCANY (val)->gcmarkbit = 0; | 3324 | XMISCANY (val)->gcmarkbit = 0; |
| 3314 | return val; | 3325 | return val; |
| 3315 | } | 3326 | } |
| @@ -3319,7 +3330,7 @@ allocate_misc (enum Lisp_Misc_Type type) | |||
| 3319 | void | 3330 | void |
| 3320 | free_misc (Lisp_Object misc) | 3331 | free_misc (Lisp_Object misc) |
| 3321 | { | 3332 | { |
| 3322 | XMISCTYPE (misc) = Lisp_Misc_Free; | 3333 | XMISCANY (misc)->type = Lisp_Misc_Free; |
| 3323 | XMISC (misc)->u_free.chain = marker_free_list; | 3334 | XMISC (misc)->u_free.chain = marker_free_list; |
| 3324 | marker_free_list = XMISC (misc); | 3335 | marker_free_list = XMISC (misc); |
| 3325 | consing_since_gc -= sizeof (union Lisp_Misc); | 3336 | consing_since_gc -= sizeof (union Lisp_Misc); |
| @@ -5647,7 +5658,7 @@ mark_discard_killed_buffers (Lisp_Object list) | |||
| 5647 | { | 5658 | { |
| 5648 | CONS_MARK (XCONS (tail)); | 5659 | CONS_MARK (XCONS (tail)); |
| 5649 | mark_object (XCAR (tail)); | 5660 | mark_object (XCAR (tail)); |
| 5650 | prev = &XCDR_AS_LVALUE (tail); | 5661 | prev = xcdr_addr (tail); |
| 5651 | } | 5662 | } |
| 5652 | } | 5663 | } |
| 5653 | mark_object (tail); | 5664 | mark_object (tail); |
| @@ -6689,8 +6700,5 @@ union | |||
| 6689 | enum MAX_ALLOCA MAX_ALLOCA; | 6700 | enum MAX_ALLOCA MAX_ALLOCA; |
| 6690 | enum More_Lisp_Bits More_Lisp_Bits; | 6701 | enum More_Lisp_Bits More_Lisp_Bits; |
| 6691 | enum pvec_type pvec_type; | 6702 | enum pvec_type pvec_type; |
| 6692 | #if USE_LSB_TAG | ||
| 6693 | enum lsb_bits lsb_bits; | ||
| 6694 | #endif | ||
| 6695 | } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; | 6703 | } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; |
| 6696 | #endif /* __GNUC__ */ | 6704 | #endif /* __GNUC__ */ |
diff --git a/src/buffer.c b/src/buffer.c index abebdf21135..08299daa7dc 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -150,6 +150,12 @@ static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay | |||
| 150 | static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); | 150 | static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); |
| 151 | static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); | 151 | static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); |
| 152 | 152 | ||
| 153 | static void | ||
| 154 | CHECK_OVERLAY (Lisp_Object x) | ||
| 155 | { | ||
| 156 | CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); | ||
| 157 | } | ||
| 158 | |||
| 153 | /* These setters are used only in this file, so they can be private. */ | 159 | /* These setters are used only in this file, so they can be private. */ |
| 154 | static void | 160 | static void |
| 155 | bset_abbrev_mode (struct buffer *b, Lisp_Object val) | 161 | bset_abbrev_mode (struct buffer *b, Lisp_Object val) |
| @@ -1539,7 +1545,7 @@ candidate_buffer (Lisp_Object b, Lisp_Object buffer) | |||
| 1539 | && BUFFER_LIVE_P (XBUFFER (b)) | 1545 | && BUFFER_LIVE_P (XBUFFER (b)) |
| 1540 | && !BUFFER_HIDDEN_P (XBUFFER (b))); | 1546 | && !BUFFER_HIDDEN_P (XBUFFER (b))); |
| 1541 | } | 1547 | } |
| 1542 | 1548 | ||
| 1543 | DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, | 1549 | DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, |
| 1544 | doc: /* Return most recently selected buffer other than BUFFER. | 1550 | doc: /* Return most recently selected buffer other than BUFFER. |
| 1545 | Buffers not visible in windows are preferred to visible buffers, unless | 1551 | Buffers not visible in windows are preferred to visible buffers, unless |
diff --git a/src/chartab.c b/src/chartab.c index 7430235b4af..1c76e5a21e9 100644 --- a/src/chartab.c +++ b/src/chartab.c | |||
| @@ -84,6 +84,22 @@ static uniprop_decoder_t uniprop_get_decoder (Lisp_Object); | |||
| 84 | (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ | 84 | (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ |
| 85 | && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) | 85 | && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) |
| 86 | 86 | ||
| 87 | static void | ||
| 88 | CHECK_CHAR_TABLE (Lisp_Object x) | ||
| 89 | { | ||
| 90 | CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x); | ||
| 91 | } | ||
| 92 | |||
| 93 | static void | ||
| 94 | set_char_table_ascii (Lisp_Object table, Lisp_Object val) | ||
| 95 | { | ||
| 96 | XCHAR_TABLE (table)->ascii = val; | ||
| 97 | } | ||
| 98 | static void | ||
| 99 | set_char_table_parent (Lisp_Object table, Lisp_Object val) | ||
| 100 | { | ||
| 101 | XCHAR_TABLE (table)->parent = val; | ||
| 102 | } | ||
| 87 | 103 | ||
| 88 | DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, | 104 | DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, |
| 89 | doc: /* Return a newly created char-table, with purpose PURPOSE. | 105 | doc: /* Return a newly created char-table, with purpose PURPOSE. |
diff --git a/src/coding.c b/src/coding.c index 42fd81b6322..497c26d4856 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -655,6 +655,22 @@ static struct coding_system coding_categories[coding_category_max]; | |||
| 655 | (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ | 655 | (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ |
| 656 | } while (0) | 656 | } while (0) |
| 657 | 657 | ||
| 658 | static void | ||
| 659 | CHECK_NATNUM_CAR (Lisp_Object x) | ||
| 660 | { | ||
| 661 | Lisp_Object tmp = XCAR (x); | ||
| 662 | CHECK_NATNUM (tmp); | ||
| 663 | XSETCAR (x, tmp); | ||
| 664 | } | ||
| 665 | |||
| 666 | static void | ||
| 667 | CHECK_NATNUM_CDR (Lisp_Object x) | ||
| 668 | { | ||
| 669 | Lisp_Object tmp = XCDR (x); | ||
| 670 | CHECK_NATNUM (tmp); | ||
| 671 | XSETCDR (x, tmp); | ||
| 672 | } | ||
| 673 | |||
| 658 | 674 | ||
| 659 | /* Safely get one byte from the source text pointed by SRC which ends | 675 | /* Safely get one byte from the source text pointed by SRC which ends |
| 660 | at SRC_END, and set C to that byte. If there are not enough bytes | 676 | at SRC_END, and set C to that byte. If there are not enough bytes |
diff --git a/src/data.c b/src/data.c index 9f756de014a..955c39727bb 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -76,7 +76,8 @@ static Lisp_Object Qprocess, Qmarker; | |||
| 76 | static Lisp_Object Qcompiled_function, Qframe; | 76 | static Lisp_Object Qcompiled_function, Qframe; |
| 77 | Lisp_Object Qbuffer; | 77 | Lisp_Object Qbuffer; |
| 78 | static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; | 78 | static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; |
| 79 | static Lisp_Object Qsubrp, Qmany, Qunevalled; | 79 | static Lisp_Object Qsubrp; |
| 80 | static Lisp_Object Qmany, Qunevalled; | ||
| 80 | Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; | 81 | Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; |
| 81 | static Lisp_Object Qdefun; | 82 | static Lisp_Object Qdefun; |
| 82 | 83 | ||
| @@ -85,6 +86,94 @@ static Lisp_Object Qdefalias_fset_function; | |||
| 85 | 86 | ||
| 86 | static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); | 87 | static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); |
| 87 | 88 | ||
| 89 | static bool | ||
| 90 | BOOLFWDP (union Lisp_Fwd *a) | ||
| 91 | { | ||
| 92 | return XFWDTYPE (a) == Lisp_Fwd_Bool; | ||
| 93 | } | ||
| 94 | static bool | ||
| 95 | INTFWDP (union Lisp_Fwd *a) | ||
| 96 | { | ||
| 97 | return XFWDTYPE (a) == Lisp_Fwd_Int; | ||
| 98 | } | ||
| 99 | static bool | ||
| 100 | KBOARD_OBJFWDP (union Lisp_Fwd *a) | ||
| 101 | { | ||
| 102 | return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj; | ||
| 103 | } | ||
| 104 | static bool | ||
| 105 | OBJFWDP (union Lisp_Fwd *a) | ||
| 106 | { | ||
| 107 | return XFWDTYPE (a) == Lisp_Fwd_Obj; | ||
| 108 | } | ||
| 109 | |||
| 110 | static struct Lisp_Boolfwd * | ||
| 111 | XBOOLFWD (union Lisp_Fwd *a) | ||
| 112 | { | ||
| 113 | eassert (BOOLFWDP (a)); | ||
| 114 | return &a->u_boolfwd; | ||
| 115 | } | ||
| 116 | static struct Lisp_Kboard_Objfwd * | ||
| 117 | XKBOARD_OBJFWD (union Lisp_Fwd *a) | ||
| 118 | { | ||
| 119 | eassert (KBOARD_OBJFWDP (a)); | ||
| 120 | return &a->u_kboard_objfwd; | ||
| 121 | } | ||
| 122 | static struct Lisp_Intfwd * | ||
| 123 | XINTFWD (union Lisp_Fwd *a) | ||
| 124 | { | ||
| 125 | eassert (INTFWDP (a)); | ||
| 126 | return &a->u_intfwd; | ||
| 127 | } | ||
| 128 | static struct Lisp_Objfwd * | ||
| 129 | XOBJFWD (union Lisp_Fwd *a) | ||
| 130 | { | ||
| 131 | eassert (OBJFWDP (a)); | ||
| 132 | return &a->u_objfwd; | ||
| 133 | } | ||
| 134 | |||
| 135 | static void | ||
| 136 | CHECK_SUBR (Lisp_Object x) | ||
| 137 | { | ||
| 138 | CHECK_TYPE (SUBRP (x), Qsubrp, x); | ||
| 139 | } | ||
| 140 | |||
| 141 | static void | ||
| 142 | set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) | ||
| 143 | { | ||
| 144 | eassert (found == !EQ (blv->defcell, blv->valcell)); | ||
| 145 | blv->found = found; | ||
| 146 | } | ||
| 147 | |||
| 148 | static Lisp_Object | ||
| 149 | blv_value (struct Lisp_Buffer_Local_Value *blv) | ||
| 150 | { | ||
| 151 | return XCDR (blv->valcell); | ||
| 152 | } | ||
| 153 | |||
| 154 | static void | ||
| 155 | set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 156 | { | ||
| 157 | XSETCDR (blv->valcell, val); | ||
| 158 | } | ||
| 159 | |||
| 160 | static void | ||
| 161 | set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 162 | { | ||
| 163 | blv->where = val; | ||
| 164 | } | ||
| 165 | |||
| 166 | static void | ||
| 167 | set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 168 | { | ||
| 169 | blv->defcell = val; | ||
| 170 | } | ||
| 171 | |||
| 172 | static void | ||
| 173 | set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 174 | { | ||
| 175 | blv->valcell = val; | ||
| 176 | } | ||
| 88 | 177 | ||
| 89 | Lisp_Object | 178 | Lisp_Object |
| 90 | wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) | 179 | wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) |
diff --git a/src/dispextern.h b/src/dispextern.h index 83e8792dfe0..401b3f2f6ae 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -22,6 +22,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 22 | #ifndef DISPEXTERN_H_INCLUDED | 22 | #ifndef DISPEXTERN_H_INCLUDED |
| 23 | #define DISPEXTERN_H_INCLUDED | 23 | #define DISPEXTERN_H_INCLUDED |
| 24 | 24 | ||
| 25 | #include "character.h" | ||
| 26 | |||
| 25 | #ifdef HAVE_X_WINDOWS | 27 | #ifdef HAVE_X_WINDOWS |
| 26 | 28 | ||
| 27 | #include <X11/Xlib.h> | 29 | #include <X11/Xlib.h> |
| @@ -270,6 +272,55 @@ struct display_pos | |||
| 270 | Glyphs | 272 | Glyphs |
| 271 | ***********************************************************************/ | 273 | ***********************************************************************/ |
| 272 | 274 | ||
| 275 | /* The glyph datatype, used to represent characters on the display. | ||
| 276 | It consists of a char code and a face id. */ | ||
| 277 | |||
| 278 | typedef struct { | ||
| 279 | int ch; | ||
| 280 | int face_id; | ||
| 281 | } GLYPH; | ||
| 282 | |||
| 283 | /* Return a glyph's character code. */ | ||
| 284 | DISPEXTERN_INLINE int GLYPH_CHAR (GLYPH glyph) { return glyph.ch; } | ||
| 285 | |||
| 286 | /* Return a glyph's face ID. */ | ||
| 287 | DISPEXTERN_INLINE int GLYPH_FACE (GLYPH glyph) { return glyph.face_id; } | ||
| 288 | |||
| 289 | #define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) | ||
| 290 | #define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) | ||
| 291 | #define SET_GLYPH(glyph, char, face) \ | ||
| 292 | ((glyph).ch = (char), (glyph).face_id = (face)) | ||
| 293 | |||
| 294 | /* The following are valid only if GLYPH_CODE_P (gc). */ | ||
| 295 | |||
| 296 | DISPEXTERN_INLINE int | ||
| 297 | GLYPH_CODE_CHAR (Lisp_Object gc) | ||
| 298 | { | ||
| 299 | return (CONSP (gc) | ||
| 300 | ? XINT (XCAR (gc)) | ||
| 301 | : XINT (gc) & MAX_CHAR); | ||
| 302 | } | ||
| 303 | |||
| 304 | DISPEXTERN_INLINE int | ||
| 305 | GLYPH_CODE_FACE (Lisp_Object gc) | ||
| 306 | { | ||
| 307 | return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS; | ||
| 308 | } | ||
| 309 | |||
| 310 | #define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ | ||
| 311 | do \ | ||
| 312 | { \ | ||
| 313 | if (CONSP (gc)) \ | ||
| 314 | SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ | ||
| 315 | else \ | ||
| 316 | SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ | ||
| 317 | (XINT (gc) >> CHARACTERBITS)); \ | ||
| 318 | } \ | ||
| 319 | while (0) | ||
| 320 | |||
| 321 | /* The ID of the mode line highlighting face. */ | ||
| 322 | enum { GLYPH_MODE_LINE_FACE = 1 }; | ||
| 323 | |||
| 273 | /* Enumeration of glyph types. Glyph structures contain a type field | 324 | /* Enumeration of glyph types. Glyph structures contain a type field |
| 274 | containing one of the enumerators defined here. */ | 325 | containing one of the enumerators defined here. */ |
| 275 | 326 | ||
| @@ -1774,6 +1825,30 @@ struct face_cache | |||
| 1774 | 1825 | ||
| 1775 | #endif /* not HAVE_WINDOW_SYSTEM */ | 1826 | #endif /* not HAVE_WINDOW_SYSTEM */ |
| 1776 | 1827 | ||
| 1828 | /* Return true if G contains a valid character code. */ | ||
| 1829 | DISPEXTERN_INLINE bool | ||
| 1830 | GLYPH_CHAR_VALID_P (GLYPH g) | ||
| 1831 | { | ||
| 1832 | return CHAR_VALID_P (GLYPH_CHAR (g)); | ||
| 1833 | } | ||
| 1834 | |||
| 1835 | /* The glyph code from a display vector may either be an integer which | ||
| 1836 | encodes a char code in the lower CHARACTERBITS bits and a (very small) | ||
| 1837 | face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ | ||
| 1838 | |||
| 1839 | DISPEXTERN_INLINE bool | ||
| 1840 | GLYPH_CODE_P (Lisp_Object gc) | ||
| 1841 | { | ||
| 1842 | return (CONSP (gc) | ||
| 1843 | ? (CHARACTERP (XCAR (gc)) | ||
| 1844 | && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) | ||
| 1845 | : (RANGED_INTEGERP | ||
| 1846 | (0, gc, | ||
| 1847 | (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS | ||
| 1848 | ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR | ||
| 1849 | : TYPE_MAXIMUM (EMACS_INT))))); | ||
| 1850 | } | ||
| 1851 | |||
| 1777 | /* Non-zero means face attributes have been changed since the last | 1852 | /* Non-zero means face attributes have been changed since the last |
| 1778 | redisplay. Used in redisplay_internal. */ | 1853 | redisplay. Used in redisplay_internal. */ |
| 1779 | 1854 | ||
diff --git a/src/emacs.c b/src/emacs.c index 0035daa1da2..13f6d117ebc 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -306,6 +306,13 @@ bool fatal_error_in_progress; | |||
| 306 | static void *ns_pool; | 306 | static void *ns_pool; |
| 307 | #endif | 307 | #endif |
| 308 | 308 | ||
| 309 | #if !HAVE_SETLOCALE | ||
| 310 | static char * | ||
| 311 | setlocale (int cat, char const *locale) | ||
| 312 | { | ||
| 313 | return 0; | ||
| 314 | } | ||
| 315 | #endif | ||
| 309 | 316 | ||
| 310 | 317 | ||
| 311 | /* Report a fatal error due to signal SIG, output a backtrace of at | 318 | /* Report a fatal error due to signal SIG, output a backtrace of at |
diff --git a/src/eval.c b/src/eval.c index d1d074df777..1b2f3bdc048 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -115,6 +115,69 @@ Lisp_Object inhibit_lisp_code; | |||
| 115 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 115 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 116 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 116 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 117 | 117 | ||
| 118 | static Lisp_Object | ||
| 119 | specpdl_symbol (struct specbinding *pdl) | ||
| 120 | { | ||
| 121 | eassert (pdl->kind >= SPECPDL_LET); | ||
| 122 | return pdl->v.let.symbol; | ||
| 123 | } | ||
| 124 | |||
| 125 | static Lisp_Object | ||
| 126 | specpdl_old_value (struct specbinding *pdl) | ||
| 127 | { | ||
| 128 | eassert (pdl->kind >= SPECPDL_LET); | ||
| 129 | return pdl->v.let.old_value; | ||
| 130 | } | ||
| 131 | |||
| 132 | static Lisp_Object | ||
| 133 | specpdl_where (struct specbinding *pdl) | ||
| 134 | { | ||
| 135 | eassert (pdl->kind > SPECPDL_LET); | ||
| 136 | return pdl->v.let.where; | ||
| 137 | } | ||
| 138 | |||
| 139 | static Lisp_Object | ||
| 140 | specpdl_arg (struct specbinding *pdl) | ||
| 141 | { | ||
| 142 | eassert (pdl->kind == SPECPDL_UNWIND); | ||
| 143 | return pdl->v.unwind.arg; | ||
| 144 | } | ||
| 145 | |||
| 146 | static specbinding_func | ||
| 147 | specpdl_func (struct specbinding *pdl) | ||
| 148 | { | ||
| 149 | eassert (pdl->kind == SPECPDL_UNWIND); | ||
| 150 | return pdl->v.unwind.func; | ||
| 151 | } | ||
| 152 | |||
| 153 | static Lisp_Object | ||
| 154 | backtrace_function (struct specbinding *pdl) | ||
| 155 | { | ||
| 156 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 157 | return pdl->v.bt.function; | ||
| 158 | } | ||
| 159 | |||
| 160 | static ptrdiff_t | ||
| 161 | backtrace_nargs (struct specbinding *pdl) | ||
| 162 | { | ||
| 163 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 164 | return pdl->v.bt.nargs; | ||
| 165 | } | ||
| 166 | |||
| 167 | static Lisp_Object * | ||
| 168 | backtrace_args (struct specbinding *pdl) | ||
| 169 | { | ||
| 170 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 171 | return pdl->v.bt.args; | ||
| 172 | } | ||
| 173 | |||
| 174 | static bool | ||
| 175 | backtrace_debug_on_exit (struct specbinding *pdl) | ||
| 176 | { | ||
| 177 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 178 | return pdl->v.bt.debug_on_exit; | ||
| 179 | } | ||
| 180 | |||
| 118 | /* Functions to modify slots of backtrace records. */ | 181 | /* Functions to modify slots of backtrace records. */ |
| 119 | 182 | ||
| 120 | static void | 183 | static void |
diff --git a/src/floatfns.c b/src/floatfns.c index 6113758f964..d7514eca886 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -41,6 +41,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 41 | # define isnan(x) ((x) != (x)) | 41 | # define isnan(x) ((x) != (x)) |
| 42 | #endif | 42 | #endif |
| 43 | 43 | ||
| 44 | /* Check that X is a floating point number. */ | ||
| 45 | |||
| 46 | static void | ||
| 47 | CHECK_FLOAT (Lisp_Object x) | ||
| 48 | { | ||
| 49 | CHECK_TYPE (FLOATP (x), Qfloatp, x); | ||
| 50 | } | ||
| 51 | |||
| 44 | /* Extract a Lisp number as a `double', or signal an error. */ | 52 | /* Extract a Lisp number as a `double', or signal an error. */ |
| 45 | 53 | ||
| 46 | double | 54 | double |
| @@ -91,6 +91,12 @@ enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; | |||
| 91 | 91 | ||
| 92 | /* Random data-structure functions. */ | 92 | /* Random data-structure functions. */ |
| 93 | 93 | ||
| 94 | static void | ||
| 95 | CHECK_LIST_END (Lisp_Object x, Lisp_Object y) | ||
| 96 | { | ||
| 97 | CHECK_TYPE (NILP (x), Qlistp, y); | ||
| 98 | } | ||
| 99 | |||
| 94 | DEFUN ("length", Flength, Slength, 1, 1, 0, | 100 | DEFUN ("length", Flength, Slength, 1, 1, 0, |
| 95 | doc: /* Return the length of vector, list or string SEQUENCE. | 101 | doc: /* Return the length of vector, list or string SEQUENCE. |
| 96 | A byte-code function object is also allowed. | 102 | A byte-code function object is also allowed. |
| @@ -3337,7 +3343,8 @@ static struct Lisp_Hash_Table *weak_hash_tables; | |||
| 3337 | 3343 | ||
| 3338 | /* Various symbols. */ | 3344 | /* Various symbols. */ |
| 3339 | 3345 | ||
| 3340 | static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; | 3346 | static Lisp_Object Qhash_table_p; |
| 3347 | static Lisp_Object Qkey, Qvalue, Qeql; | ||
| 3341 | Lisp_Object Qeq, Qequal; | 3348 | Lisp_Object Qeq, Qequal; |
| 3342 | Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; | 3349 | Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; |
| 3343 | static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; | 3350 | static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; |
| @@ -3347,6 +3354,48 @@ static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; | |||
| 3347 | Utilities | 3354 | Utilities |
| 3348 | ***********************************************************************/ | 3355 | ***********************************************************************/ |
| 3349 | 3356 | ||
| 3357 | static void | ||
| 3358 | CHECK_HASH_TABLE (Lisp_Object x) | ||
| 3359 | { | ||
| 3360 | CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x); | ||
| 3361 | } | ||
| 3362 | |||
| 3363 | static void | ||
| 3364 | set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) | ||
| 3365 | { | ||
| 3366 | h->key_and_value = key_and_value; | ||
| 3367 | } | ||
| 3368 | static void | ||
| 3369 | set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) | ||
| 3370 | { | ||
| 3371 | h->next = next; | ||
| 3372 | } | ||
| 3373 | static void | ||
| 3374 | set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 3375 | { | ||
| 3376 | gc_aset (h->next, idx, val); | ||
| 3377 | } | ||
| 3378 | static void | ||
| 3379 | set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) | ||
| 3380 | { | ||
| 3381 | h->hash = hash; | ||
| 3382 | } | ||
| 3383 | static void | ||
| 3384 | set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 3385 | { | ||
| 3386 | gc_aset (h->hash, idx, val); | ||
| 3387 | } | ||
| 3388 | static void | ||
| 3389 | set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) | ||
| 3390 | { | ||
| 3391 | h->index = index; | ||
| 3392 | } | ||
| 3393 | static void | ||
| 3394 | set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 3395 | { | ||
| 3396 | gc_aset (h->index, idx, val); | ||
| 3397 | } | ||
| 3398 | |||
| 3350 | /* If OBJ is a Lisp hash table, return a pointer to its struct | 3399 | /* If OBJ is a Lisp hash table, return a pointer to its struct |
| 3351 | Lisp_Hash_Table. Otherwise, signal an error. */ | 3400 | Lisp_Hash_Table. Otherwise, signal an error. */ |
| 3352 | 3401 | ||
diff --git a/src/keymap.c b/src/keymap.c index 536db77f59b..4e3eff332cc 100644 --- a/src/keymap.c +++ b/src/keymap.c | |||
| @@ -106,6 +106,12 @@ static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, | |||
| 106 | Lisp_Object, Lisp_Object, bool, bool); | 106 | Lisp_Object, Lisp_Object, bool, bool); |
| 107 | static void silly_event_symbol_error (Lisp_Object); | 107 | static void silly_event_symbol_error (Lisp_Object); |
| 108 | static Lisp_Object get_keyelt (Lisp_Object, bool); | 108 | static Lisp_Object get_keyelt (Lisp_Object, bool); |
| 109 | |||
| 110 | static void | ||
| 111 | CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) | ||
| 112 | { | ||
| 113 | CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); | ||
| 114 | } | ||
| 109 | 115 | ||
| 110 | /* Keymap object support - constructors and predicates. */ | 116 | /* Keymap object support - constructors and predicates. */ |
| 111 | 117 | ||
diff --git a/src/lisp.h b/src/lisp.h index ba36a320a8f..f76bbfb9ead 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -220,6 +220,139 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 }; | |||
| 220 | #endif | 220 | #endif |
| 221 | 221 | ||
| 222 | 222 | ||
| 223 | /* Some operations are so commonly executed that they are implemented | ||
| 224 | as macros, not functions, because otherwise runtime performance would | ||
| 225 | suffer too much when compiling with GCC without optimization. | ||
| 226 | There's no need to inline everything, just the operations that | ||
| 227 | would otherwise cause a serious performance problem. | ||
| 228 | |||
| 229 | For each such operation OP, define a macro lisp_h_OP that contains | ||
| 230 | the operation's implementation. That way, OP can be implementated | ||
| 231 | via a macro definition like this: | ||
| 232 | |||
| 233 | #define OP(x) lisp_h_OP (x) | ||
| 234 | |||
| 235 | and/or via a function definition like this: | ||
| 236 | |||
| 237 | LISP_MACRO_DEFUN (OP, Lisp_Object, (Lisp_Object x), (x)) | ||
| 238 | |||
| 239 | which macro-expands to this: | ||
| 240 | |||
| 241 | Lisp_Object (OP) (Lisp_Object x) { return lisp_h_OP (x); } | ||
| 242 | |||
| 243 | without worrying about the implementations diverging, since | ||
| 244 | lisp_h_OP defines the actual implementation. The lisp_h_OP macros | ||
| 245 | are intended to be private to this include file, and should not be | ||
| 246 | used elsewhere. | ||
| 247 | |||
| 248 | FIXME: Remove the lisp_h_OP macros, and define just the inline OP | ||
| 249 | functions, once most developers have access to GCC 4.8 or later and | ||
| 250 | can use "gcc -Og" to debug. Maybe in the year 2016. See | ||
| 251 | Bug#11935. | ||
| 252 | |||
| 253 | Commentary for these macros can be found near their corresponding | ||
| 254 | functions, below. */ | ||
| 255 | |||
| 256 | #if CHECK_LISP_OBJECT_TYPE | ||
| 257 | # define lisp_h_XLI(o) ((o).i) | ||
| 258 | # define lisp_h_XIL(i) ((Lisp_Object) { i }) | ||
| 259 | #else | ||
| 260 | # define lisp_h_XLI(o) (o) | ||
| 261 | # define lisp_h_XIL(i) (i) | ||
| 262 | #endif | ||
| 263 | #define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) | ||
| 264 | #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) | ||
| 265 | #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) | ||
| 266 | #define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \ | ||
| 267 | ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x)) | ||
| 268 | #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) | ||
| 269 | #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) | ||
| 270 | #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) | ||
| 271 | #define lisp_h_INTEGERP(x) ((XTYPE (x) & ~Lisp_Int1) == 0) | ||
| 272 | #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) | ||
| 273 | #define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) | ||
| 274 | #define lisp_h_NILP(x) EQ (x, Qnil) | ||
| 275 | #define lisp_h_SET_SYMBOL_VAL(sym, v) \ | ||
| 276 | (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) | ||
| 277 | #define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) | ||
| 278 | #define lisp_h_SYMBOL_VAL(sym) \ | ||
| 279 | (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) | ||
| 280 | #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) | ||
| 281 | #define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) | ||
| 282 | #define lisp_h_XCAR(c) XCONS (c)->car | ||
| 283 | #define lisp_h_XCDR(c) XCONS (c)->u.cdr | ||
| 284 | #define lisp_h_XCONS(a) \ | ||
| 285 | (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) | ||
| 286 | #define lisp_h_XHASH(a) XUINT (a) | ||
| 287 | #define lisp_h_XPNTR(a) \ | ||
| 288 | ((void *) (intptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) | ||
| 289 | #define lisp_h_XSYMBOL(a) \ | ||
| 290 | (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) | ||
| 291 | #ifndef GC_CHECK_CONS_LIST | ||
| 292 | # define lisp_h_check_cons_list() ((void) 0) | ||
| 293 | #endif | ||
| 294 | #if USE_LSB_TAG | ||
| 295 | # define lisp_h_make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS) | ||
| 296 | # define lisp_h_XFASTINT(a) XINT (a) | ||
| 297 | # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) | ||
| 298 | # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) | ||
| 299 | # define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type))) | ||
| 300 | #endif | ||
| 301 | |||
| 302 | /* When compiling via gcc -O0, define the key operations as macros, as | ||
| 303 | Emacs is too slow otherwise. To disable this optimization, compile | ||
| 304 | with -DINLINING=0. */ | ||
| 305 | #if (defined __NO_INLINE__ \ | ||
| 306 | && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ | ||
| 307 | && ! (defined INLINING && ! INLINING)) | ||
| 308 | # define XLI(o) lisp_h_XLI (o) | ||
| 309 | # define XIL(i) lisp_h_XIL (i) | ||
| 310 | # define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) | ||
| 311 | # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) | ||
| 312 | # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) | ||
| 313 | # define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x) | ||
| 314 | # define CONSP(x) lisp_h_CONSP (x) | ||
| 315 | # define EQ(x, y) lisp_h_EQ (x, y) | ||
| 316 | # define FLOATP(x) lisp_h_FLOATP (x) | ||
| 317 | # define INTEGERP(x) lisp_h_INTEGERP (x) | ||
| 318 | # define MARKERP(x) lisp_h_MARKERP (x) | ||
| 319 | # define MISCP(x) lisp_h_MISCP (x) | ||
| 320 | # define NILP(x) lisp_h_NILP (x) | ||
| 321 | # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) | ||
| 322 | # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) | ||
| 323 | # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) | ||
| 324 | # define SYMBOLP(x) lisp_h_SYMBOLP (x) | ||
| 325 | # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) | ||
| 326 | # define XCAR(c) lisp_h_XCAR (c) | ||
| 327 | # define XCDR(c) lisp_h_XCDR (c) | ||
| 328 | # define XCONS(a) lisp_h_XCONS (a) | ||
| 329 | # define XHASH(a) lisp_h_XHASH (a) | ||
| 330 | # define XPNTR(a) lisp_h_XPNTR (a) | ||
| 331 | # define XSYMBOL(a) lisp_h_XSYMBOL (a) | ||
| 332 | # ifndef GC_CHECK_CONS_LIST | ||
| 333 | # define check_cons_list() lisp_h_check_cons_list () | ||
| 334 | # endif | ||
| 335 | # if USE_LSB_TAG | ||
| 336 | # define make_number(n) lisp_h_make_number (n) | ||
| 337 | # define XFASTINT(a) lisp_h_XFASTINT (a) | ||
| 338 | # define XINT(a) lisp_h_XINT (a) | ||
| 339 | # define XTYPE(a) lisp_h_XTYPE (a) | ||
| 340 | # define XUNTAG(a, type) lisp_h_XUNTAG (a, type) | ||
| 341 | # endif | ||
| 342 | #endif | ||
| 343 | |||
| 344 | /* Define NAME as a lisp.h inline function that returns TYPE and has | ||
| 345 | arguments declared as ARGDECLS and passed as ARGS. ARGDECLS and | ||
| 346 | ARGS should be parenthesized. Implement the function by calling | ||
| 347 | lisp_h_NAME ARGS. */ | ||
| 348 | #define LISP_MACRO_DEFUN(name, type, argdecls, args) \ | ||
| 349 | LISP_INLINE type (name) argdecls { return lisp_h_##name args; } | ||
| 350 | |||
| 351 | /* like LISP_MACRO_DEFUN, except NAME returns void. */ | ||
| 352 | #define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \ | ||
| 353 | LISP_INLINE void (name) argdecls { lisp_h_##name args; } | ||
| 354 | |||
| 355 | |||
| 223 | /* Define the fundamental Lisp data structures. */ | 356 | /* Define the fundamental Lisp data structures. */ |
| 224 | 357 | ||
| 225 | /* This is the set of Lisp data types. If you want to define a new | 358 | /* This is the set of Lisp data types. If you want to define a new |
| @@ -230,7 +363,6 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 }; | |||
| 230 | extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ | 363 | extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ |
| 231 | #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) | 364 | #define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) |
| 232 | #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 | 365 | #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 |
| 233 | #define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0) | ||
| 234 | 366 | ||
| 235 | /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, | 367 | /* Idea stolen from GDB. MSVC doesn't support enums in bitfields, |
| 236 | and xlc complains vociferously about them. */ | 368 | and xlc complains vociferously about them. */ |
| @@ -359,20 +491,6 @@ enum Lisp_Fwd_Type | |||
| 359 | 491 | ||
| 360 | typedef struct { EMACS_INT i; } Lisp_Object; | 492 | typedef struct { EMACS_INT i; } Lisp_Object; |
| 361 | 493 | ||
| 362 | #define XLI(o) (o).i | ||
| 363 | LISP_INLINE Lisp_Object | ||
| 364 | XIL (EMACS_INT i) | ||
| 365 | { | ||
| 366 | Lisp_Object o = { i }; | ||
| 367 | return o; | ||
| 368 | } | ||
| 369 | |||
| 370 | LISP_INLINE Lisp_Object | ||
| 371 | LISP_MAKE_RVALUE (Lisp_Object o) | ||
| 372 | { | ||
| 373 | return o; | ||
| 374 | } | ||
| 375 | |||
| 376 | #define LISP_INITIALLY_ZERO {0} | 494 | #define LISP_INITIALLY_ZERO {0} |
| 377 | 495 | ||
| 378 | #undef CHECK_LISP_OBJECT_TYPE | 496 | #undef CHECK_LISP_OBJECT_TYPE |
| @@ -382,13 +500,15 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 }; | |||
| 382 | /* If a struct type is not wanted, define Lisp_Object as just a number. */ | 500 | /* If a struct type is not wanted, define Lisp_Object as just a number. */ |
| 383 | 501 | ||
| 384 | typedef EMACS_INT Lisp_Object; | 502 | typedef EMACS_INT Lisp_Object; |
| 385 | #define XLI(o) (o) | ||
| 386 | #define XIL(i) (i) | ||
| 387 | #define LISP_MAKE_RVALUE(o) (0 + (o)) | ||
| 388 | #define LISP_INITIALLY_ZERO 0 | 503 | #define LISP_INITIALLY_ZERO 0 |
| 389 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; | 504 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; |
| 390 | #endif /* CHECK_LISP_OBJECT_TYPE */ | 505 | #endif /* CHECK_LISP_OBJECT_TYPE */ |
| 391 | 506 | ||
| 507 | /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. | ||
| 508 | At the machine level, these operations are no-ops. */ | ||
| 509 | LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) | ||
| 510 | LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i)) | ||
| 511 | |||
| 392 | /* In the size word of a vector, this bit means the vector has been marked. */ | 512 | /* In the size word of a vector, this bit means the vector has been marked. */ |
| 393 | 513 | ||
| 394 | static ptrdiff_t const ARRAY_MARK_FLAG | 514 | static ptrdiff_t const ARRAY_MARK_FLAG |
| @@ -460,84 +580,108 @@ enum More_Lisp_Bits | |||
| 460 | BOOL_VECTOR_BITS_PER_CHAR = 8 | 580 | BOOL_VECTOR_BITS_PER_CHAR = 8 |
| 461 | }; | 581 | }; |
| 462 | 582 | ||
| 463 | /* These macros extract various sorts of values from a Lisp_Object. | 583 | /* These functions extract various sorts of values from a Lisp_Object. |
| 464 | For example, if tem is a Lisp_Object whose type is Lisp_Cons, | 584 | For example, if tem is a Lisp_Object whose type is Lisp_Cons, |
| 465 | XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ | 585 | XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ |
| 466 | 586 | ||
| 467 | #if USE_LSB_TAG | 587 | static EMACS_INT const VALMASK |
| 588 | #define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) | ||
| 589 | = VALMASK; | ||
| 468 | 590 | ||
| 469 | enum lsb_bits | 591 | /* Largest and smallest representable fixnum values. These are the C |
| 470 | { | 592 | values. They are macros for use in static initializers. */ |
| 471 | TYPEMASK = (1 << GCTYPEBITS) - 1, | 593 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) |
| 472 | VALMASK = ~ TYPEMASK | 594 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) |
| 473 | }; | ||
| 474 | #define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) | ||
| 475 | #define XINT(a) (XLI (a) >> INTTYPEBITS) | ||
| 476 | #define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) | ||
| 477 | #define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) | ||
| 478 | #define make_lisp_ptr(ptr, type) \ | ||
| 479 | (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ | ||
| 480 | XIL ((type) | (intptr_t) (ptr))) | ||
| 481 | 595 | ||
| 482 | #define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) | 596 | /* Extract the pointer hidden within A. */ |
| 483 | #define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) | 597 | LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) |
| 484 | 598 | ||
| 485 | #else /* not USE_LSB_TAG */ | 599 | #if USE_LSB_TAG |
| 486 | 600 | ||
| 487 | static EMACS_INT const VALMASK | 601 | LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) |
| 488 | #define VALMASK VAL_MAX | 602 | LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a)) |
| 489 | = VALMASK; | 603 | LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a)) |
| 604 | LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) | ||
| 605 | LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) | ||
| 490 | 606 | ||
| 491 | #define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) | 607 | #else /* ! USE_LSB_TAG */ |
| 492 | 608 | ||
| 493 | /* For integers known to be positive, XFASTINT provides fast retrieval | 609 | /* Although compiled only if ! USE_LSB_TAG, the following functions |
| 494 | and XSETFASTINT provides fast storage. This takes advantage of the | 610 | also work when USE_LSB_TAG; this is to aid future maintenance when |
| 495 | fact that Lisp integers have zero-bits in their tags. */ | 611 | the lisp_h_* macros are eventually removed. */ |
| 496 | #define XFASTINT(a) (XLI (a) + 0) | ||
| 497 | #define XSETFASTINT(a, b) ((a) = XIL (b)) | ||
| 498 | 612 | ||
| 499 | /* Extract the value of a Lisp_Object as a (un)signed integer. */ | 613 | /* Make a Lisp integer representing the value of the low order |
| 614 | bits of N. */ | ||
| 615 | LISP_INLINE Lisp_Object | ||
| 616 | make_number (EMACS_INT n) | ||
| 617 | { | ||
| 618 | return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK); | ||
| 619 | } | ||
| 500 | 620 | ||
| 501 | #define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) | 621 | /* Extract A's value as a signed integer. */ |
| 502 | #define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) | 622 | LISP_INLINE EMACS_INT |
| 503 | #define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) | 623 | XINT (Lisp_Object a) |
| 624 | { | ||
| 625 | EMACS_INT i = XLI (a); | ||
| 626 | return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS; | ||
| 627 | } | ||
| 504 | 628 | ||
| 505 | #define make_lisp_ptr(ptr, type) \ | 629 | /* Like XINT (A), but may be faster. A must be nonnegative. |
| 506 | (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ | 630 | If ! USE_LSB_TAG, this takes advantage of the fact that Lisp |
| 507 | + ((intptr_t) (ptr) & VALMASK))) | 631 | integers have zero-bits in their tags. */ |
| 632 | LISP_INLINE EMACS_INT | ||
| 633 | XFASTINT (Lisp_Object a) | ||
| 634 | { | ||
| 635 | EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a); | ||
| 636 | eassert (0 <= n); | ||
| 637 | return n; | ||
| 638 | } | ||
| 508 | 639 | ||
| 509 | /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers | 640 | /* Extract A's type. */ |
| 510 | which were stored in a Lisp_Object. */ | 641 | LISP_INLINE enum Lisp_Type |
| 511 | #define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK) | DATA_SEG_BITS)) | 642 | XTYPE (Lisp_Object a) |
| 643 | { | ||
| 644 | EMACS_UINT i = XLI (a); | ||
| 645 | return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; | ||
| 646 | } | ||
| 512 | 647 | ||
| 513 | #endif /* not USE_LSB_TAG */ | 648 | /* Extract A's pointer value, assuming A's type is TYPE. */ |
| 649 | LISP_INLINE void * | ||
| 650 | XUNTAG (Lisp_Object a, int type) | ||
| 651 | { | ||
| 652 | if (USE_LSB_TAG) | ||
| 653 | { | ||
| 654 | intptr_t i = XLI (a) - type; | ||
| 655 | return (void *) i; | ||
| 656 | } | ||
| 657 | return XPNTR (a); | ||
| 658 | } | ||
| 514 | 659 | ||
| 515 | /* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be | 660 | #endif /* ! USE_LSB_TAG */ |
| 516 | like XUINT right now, but XUINT should only be applied to objects we know | ||
| 517 | are integers. */ | ||
| 518 | #define XHASH(a) XUINT (a) | ||
| 519 | 661 | ||
| 520 | /* For integers known to be positive, XFASTINT sometimes provides | 662 | /* Extract A's value as an unsigned integer. */ |
| 521 | faster retrieval and XSETFASTINT provides faster storage. | 663 | LISP_INLINE EMACS_UINT |
| 522 | If not, fallback on the non-accelerated path. */ | 664 | XUINT (Lisp_Object a) |
| 523 | #ifndef XFASTINT | 665 | { |
| 524 | # define XFASTINT(a) (XINT (a)) | 666 | EMACS_UINT i = XLI (a); |
| 525 | # define XSETFASTINT(a, b) (XSETINT (a, b)) | 667 | return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; |
| 526 | #endif | 668 | } |
| 527 | 669 | ||
| 528 | /* Extract the pointer value of the Lisp object A, under the | 670 | /* Return A's (Lisp-integer sized) hash. Happens to be like XUINT |
| 529 | assumption that A's type is TYPE. This is a fallback | 671 | right now, but XUINT should only be applied to objects we know are |
| 530 | implementation if nothing faster is available. */ | 672 | integers. */ |
| 531 | #ifndef XUNTAG | 673 | LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a)) |
| 532 | # define XUNTAG(a, type) XPNTR (a) | ||
| 533 | #endif | ||
| 534 | 674 | ||
| 535 | #define EQ(x, y) (XLI (x) == XLI (y)) | 675 | /* Like make_number (N), but may be faster. N must be in nonnegative range. */ |
| 676 | LISP_INLINE Lisp_Object | ||
| 677 | make_natnum (EMACS_INT n) | ||
| 678 | { | ||
| 679 | eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); | ||
| 680 | return USE_LSB_TAG ? make_number (n) : XIL (n); | ||
| 681 | } | ||
| 536 | 682 | ||
| 537 | /* Largest and smallest representable fixnum values. These are the C | 683 | /* Return true if X and Y are the same object. */ |
| 538 | values. They are macros for use in static initializers. */ | 684 | LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y)) |
| 539 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) | ||
| 540 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) | ||
| 541 | 685 | ||
| 542 | /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is | 686 | /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is |
| 543 | written this way so that it also works if I is of unsigned | 687 | written this way so that it also works if I is of unsigned |
| @@ -551,66 +695,173 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) | |||
| 551 | { | 695 | { |
| 552 | return num < lower ? lower : num <= upper ? num : upper; | 696 | return num < lower ? lower : num <= upper ? num : upper; |
| 553 | } | 697 | } |
| 698 | |||
| 699 | /* Forward declarations. */ | ||
| 700 | |||
| 701 | /* Defined in this file. */ | ||
| 702 | union Lisp_Fwd; | ||
| 703 | LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); | ||
| 704 | LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); | ||
| 705 | LISP_INLINE bool BUFFERP (Lisp_Object); | ||
| 706 | LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); | ||
| 707 | LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); | ||
| 708 | LISP_INLINE bool (CONSP) (Lisp_Object); | ||
| 709 | LISP_INLINE bool (FLOATP) (Lisp_Object); | ||
| 710 | LISP_INLINE bool functionp (Lisp_Object); | ||
| 711 | LISP_INLINE bool (INTEGERP) (Lisp_Object); | ||
| 712 | LISP_INLINE bool (MARKERP) (Lisp_Object); | ||
| 713 | LISP_INLINE bool (MISCP) (Lisp_Object); | ||
| 714 | LISP_INLINE bool (NILP) (Lisp_Object); | ||
| 715 | LISP_INLINE bool OVERLAYP (Lisp_Object); | ||
| 716 | LISP_INLINE bool PROCESSP (Lisp_Object); | ||
| 717 | LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); | ||
| 718 | LISP_INLINE bool SAVE_VALUEP (Lisp_Object); | ||
| 719 | LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, | ||
| 720 | Lisp_Object); | ||
| 721 | LISP_INLINE bool STRINGP (Lisp_Object); | ||
| 722 | LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); | ||
| 723 | LISP_INLINE bool SUBRP (Lisp_Object); | ||
| 724 | LISP_INLINE bool (SYMBOLP) (Lisp_Object); | ||
| 725 | LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); | ||
| 726 | LISP_INLINE bool WINDOWP (Lisp_Object); | ||
| 727 | LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); | ||
| 728 | |||
| 729 | /* Defined in chartab.c. */ | ||
| 730 | extern Lisp_Object char_table_ref (Lisp_Object, int); | ||
| 731 | extern void char_table_set (Lisp_Object, int, Lisp_Object); | ||
| 732 | extern int char_table_translate (Lisp_Object, int); | ||
| 733 | |||
| 734 | /* Defined in data.c. */ | ||
| 735 | extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; | ||
| 736 | extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; | ||
| 737 | extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp; | ||
| 738 | extern Lisp_Object Qvector_or_char_table_p, Qwholenump; | ||
| 739 | extern Lisp_Object Ffboundp (Lisp_Object); | ||
| 740 | extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); | ||
| 741 | |||
| 742 | /* Defined in emacs.c. */ | ||
| 743 | extern bool initialized; | ||
| 744 | |||
| 745 | /* Defined in eval.c. */ | ||
| 746 | extern Lisp_Object Qautoload; | ||
| 747 | |||
| 748 | /* Defined in floatfns.c. */ | ||
| 749 | extern double extract_float (Lisp_Object); | ||
| 554 | 750 | ||
| 751 | /* Defined in process.c. */ | ||
| 752 | extern Lisp_Object Qprocessp; | ||
| 753 | |||
| 754 | /* Defined in window.c. */ | ||
| 755 | extern Lisp_Object Qwindowp; | ||
| 756 | |||
| 757 | /* Defined in xdisp.c. */ | ||
| 758 | extern Lisp_Object Qimage; | ||
| 555 | 759 | ||
| 760 | |||
| 556 | /* Extract a value or address from a Lisp_Object. */ | 761 | /* Extract a value or address from a Lisp_Object. */ |
| 557 | 762 | ||
| 558 | #define XCONS(a) (eassert (CONSP (a)), \ | 763 | LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a)) |
| 559 | (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) | ||
| 560 | #define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ | ||
| 561 | (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) | ||
| 562 | #define XSTRING(a) (eassert (STRINGP (a)), \ | ||
| 563 | (struct Lisp_String *) XUNTAG (a, Lisp_String)) | ||
| 564 | #define XSYMBOL(a) (eassert (SYMBOLP (a)), \ | ||
| 565 | (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) | ||
| 566 | #define XFLOAT(a) (eassert (FLOATP (a)), \ | ||
| 567 | (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) | ||
| 568 | 764 | ||
| 569 | /* Misc types. */ | 765 | LISP_INLINE struct Lisp_Vector * |
| 766 | XVECTOR (Lisp_Object a) | ||
| 767 | { | ||
| 768 | eassert (VECTORLIKEP (a)); | ||
| 769 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 770 | } | ||
| 570 | 771 | ||
| 571 | #define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) | 772 | LISP_INLINE struct Lisp_String * |
| 572 | #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) | 773 | XSTRING (Lisp_Object a) |
| 573 | #define XMISCTYPE(a) (XMISCANY (a)->type) | 774 | { |
| 574 | #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) | 775 | eassert (STRINGP (a)); |
| 575 | #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) | 776 | return XUNTAG (a, Lisp_String); |
| 777 | } | ||
| 576 | 778 | ||
| 577 | /* Forwarding object types. */ | 779 | LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) |
| 578 | 780 | ||
| 579 | #define XFWDTYPE(a) (a->u_intfwd.type) | 781 | LISP_INLINE struct Lisp_Float * |
| 580 | #define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) | 782 | XFLOAT (Lisp_Object a) |
| 581 | #define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) | 783 | { |
| 582 | #define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) | 784 | eassert (FLOATP (a)); |
| 583 | #define XBUFFER_OBJFWD(a) \ | 785 | return XUNTAG (a, Lisp_Float); |
| 584 | (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) | 786 | } |
| 585 | #define XKBOARD_OBJFWD(a) \ | ||
| 586 | (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) | ||
| 587 | 787 | ||
| 588 | /* Pseudovector types. */ | 788 | /* Pseudovector types. */ |
| 589 | struct Lisp_Process; | 789 | |
| 590 | LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) | 790 | LISP_INLINE struct Lisp_Process * |
| 591 | { return make_lisp_ptr (p, Lisp_Vectorlike); } | 791 | XPROCESS (Lisp_Object a) |
| 592 | #define XPROCESS(a) (eassert (PROCESSP (a)), \ | 792 | { |
| 593 | (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) | 793 | eassert (PROCESSP (a)); |
| 594 | #define XWINDOW(a) (eassert (WINDOWP (a)), \ | 794 | return XUNTAG (a, Lisp_Vectorlike); |
| 595 | (struct window *) XUNTAG (a, Lisp_Vectorlike)) | 795 | } |
| 596 | #define XTERMINAL(a) (eassert (TERMINALP (a)), \ | 796 | |
| 597 | (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) | 797 | LISP_INLINE struct window * |
| 598 | #define XSUBR(a) (eassert (SUBRP (a)), \ | 798 | XWINDOW (Lisp_Object a) |
| 599 | (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) | 799 | { |
| 600 | #define XBUFFER(a) (eassert (BUFFERP (a)), \ | 800 | eassert (WINDOWP (a)); |
| 601 | (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) | 801 | return XUNTAG (a, Lisp_Vectorlike); |
| 602 | #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ | 802 | } |
| 603 | (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) | 803 | |
| 604 | #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ | 804 | LISP_INLINE struct terminal * |
| 605 | ((struct Lisp_Sub_Char_Table *) \ | 805 | XTERMINAL (Lisp_Object a) |
| 606 | XUNTAG (a, Lisp_Vectorlike))) | 806 | { |
| 607 | #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ | 807 | return XUNTAG (a, Lisp_Vectorlike); |
| 608 | ((struct Lisp_Bool_Vector *) \ | 808 | } |
| 609 | XUNTAG (a, Lisp_Vectorlike))) | 809 | |
| 810 | LISP_INLINE struct Lisp_Subr * | ||
| 811 | XSUBR (Lisp_Object a) | ||
| 812 | { | ||
| 813 | eassert (SUBRP (a)); | ||
| 814 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 815 | } | ||
| 816 | |||
| 817 | LISP_INLINE struct buffer * | ||
| 818 | XBUFFER (Lisp_Object a) | ||
| 819 | { | ||
| 820 | eassert (BUFFERP (a)); | ||
| 821 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 822 | } | ||
| 823 | |||
| 824 | LISP_INLINE struct Lisp_Char_Table * | ||
| 825 | XCHAR_TABLE (Lisp_Object a) | ||
| 826 | { | ||
| 827 | eassert (CHAR_TABLE_P (a)); | ||
| 828 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 829 | } | ||
| 830 | |||
| 831 | LISP_INLINE struct Lisp_Sub_Char_Table * | ||
| 832 | XSUB_CHAR_TABLE (Lisp_Object a) | ||
| 833 | { | ||
| 834 | eassert (SUB_CHAR_TABLE_P (a)); | ||
| 835 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 836 | } | ||
| 837 | |||
| 838 | LISP_INLINE struct Lisp_Bool_Vector * | ||
| 839 | XBOOL_VECTOR (Lisp_Object a) | ||
| 840 | { | ||
| 841 | eassert (BOOL_VECTOR_P (a)); | ||
| 842 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 843 | } | ||
| 610 | 844 | ||
| 611 | /* Construct a Lisp_Object from a value or address. */ | 845 | /* Construct a Lisp_Object from a value or address. */ |
| 612 | 846 | ||
| 847 | LISP_INLINE Lisp_Object | ||
| 848 | make_lisp_ptr (void *ptr, enum Lisp_Type type) | ||
| 849 | { | ||
| 850 | EMACS_UINT utype = type; | ||
| 851 | EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS; | ||
| 852 | Lisp_Object a = XIL (typebits | (uintptr_t) ptr); | ||
| 853 | eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); | ||
| 854 | return a; | ||
| 855 | } | ||
| 856 | |||
| 857 | LISP_INLINE Lisp_Object | ||
| 858 | make_lisp_proc (struct Lisp_Process *p) | ||
| 859 | { | ||
| 860 | return make_lisp_ptr (p, Lisp_Vectorlike); | ||
| 861 | } | ||
| 862 | |||
| 613 | #define XSETINT(a, b) ((a) = make_number (b)) | 863 | #define XSETINT(a, b) ((a) = make_number (b)) |
| 864 | #define XSETFASTINT(a, b) ((a) = make_natnum (b)) | ||
| 614 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) | 865 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) |
| 615 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) | 866 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) |
| 616 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) | 867 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) |
| @@ -656,35 +907,10 @@ LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) | |||
| 656 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) | 907 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) |
| 657 | #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) | 908 | #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) |
| 658 | 909 | ||
| 659 | /* Convenience macros for dealing with Lisp arrays. */ | ||
| 660 | |||
| 661 | #define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] | ||
| 662 | #define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size | ||
| 663 | #define ASET(ARRAY, IDX, VAL) \ | ||
| 664 | (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ | ||
| 665 | XVECTOR (ARRAY)->contents[IDX] = (VAL)) | ||
| 666 | |||
| 667 | /* Convenience macros for dealing with Lisp strings. */ | ||
| 668 | |||
| 669 | #define SDATA(string) (XSTRING (string)->data + 0) | ||
| 670 | #define SREF(string, index) (SDATA (string)[index] + 0) | ||
| 671 | #define SSET(string, index, new) (SDATA (string)[index] = (new)) | ||
| 672 | #define SCHARS(string) (XSTRING (string)->size + 0) | ||
| 673 | #define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) | ||
| 674 | |||
| 675 | /* Avoid "differ in sign" warnings. */ | ||
| 676 | #define SSDATA(x) ((char *) SDATA (x)) | ||
| 677 | |||
| 678 | #define STRING_SET_CHARS(string, newsize) \ | ||
| 679 | (XSTRING (string)->size = (newsize)) | ||
| 680 | |||
| 681 | #define STRING_COPYIN(string, index, new, count) \ | ||
| 682 | memcpy (SDATA (string) + index, new, count) | ||
| 683 | |||
| 684 | /* Type checking. */ | 910 | /* Type checking. */ |
| 685 | 911 | ||
| 686 | #define CHECK_TYPE(ok, Qxxxp, x) \ | 912 | LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), |
| 687 | do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) | 913 | (ok, Qxxxp, x)) |
| 688 | 914 | ||
| 689 | /* Deprecated and will be removed soon. */ | 915 | /* Deprecated and will be removed soon. */ |
| 690 | 916 | ||
| @@ -694,10 +920,6 @@ LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) | |||
| 694 | 920 | ||
| 695 | typedef struct interval *INTERVAL; | 921 | typedef struct interval *INTERVAL; |
| 696 | 922 | ||
| 697 | /* Complain if object is not string or buffer type. */ | ||
| 698 | #define CHECK_STRING_OR_BUFFER(x) \ | ||
| 699 | CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) | ||
| 700 | |||
| 701 | struct Lisp_Cons | 923 | struct Lisp_Cons |
| 702 | { | 924 | { |
| 703 | /* Car of this cons cell. */ | 925 | /* Car of this cons cell. */ |
| @@ -714,64 +936,86 @@ struct Lisp_Cons | |||
| 714 | }; | 936 | }; |
| 715 | 937 | ||
| 716 | /* Take the car or cdr of something known to be a cons cell. */ | 938 | /* Take the car or cdr of something known to be a cons cell. */ |
| 717 | /* The _AS_LVALUE macros shouldn't be used outside of the minimal set | 939 | /* The _addr functions shouldn't be used outside of the minimal set |
| 718 | of code that has to know what a cons cell looks like. Other code not | 940 | of code that has to know what a cons cell looks like. Other code not |
| 719 | part of the basic lisp implementation should assume that the car and cdr | 941 | part of the basic lisp implementation should assume that the car and cdr |
| 720 | fields are not accessible as lvalues. (What if we want to switch to | 942 | fields are not accessible. (What if we want to switch to |
| 721 | a copying collector someday? Cached cons cell field addresses may be | 943 | a copying collector someday? Cached cons cell field addresses may be |
| 722 | invalidated at arbitrary points.) */ | 944 | invalidated at arbitrary points.) */ |
| 723 | #define XCAR_AS_LVALUE(c) (XCONS (c)->car) | 945 | LISP_INLINE Lisp_Object * |
| 724 | #define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) | 946 | xcar_addr (Lisp_Object c) |
| 947 | { | ||
| 948 | return &XCONS (c)->car; | ||
| 949 | } | ||
| 950 | LISP_INLINE Lisp_Object * | ||
| 951 | xcdr_addr (Lisp_Object c) | ||
| 952 | { | ||
| 953 | return &XCONS (c)->u.cdr; | ||
| 954 | } | ||
| 725 | 955 | ||
| 726 | /* Use these from normal code. */ | 956 | /* Use these from normal code. */ |
| 727 | #define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) | 957 | LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c)) |
| 728 | #define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c)) | 958 | LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c)) |
| 729 | 959 | ||
| 730 | /* Use these to set the fields of a cons cell. | 960 | /* Use these to set the fields of a cons cell. |
| 731 | 961 | ||
| 732 | Note that both arguments may refer to the same object, so 'n' | 962 | Note that both arguments may refer to the same object, so 'n' |
| 733 | should not be read after 'c' is first modified. Also, neither | 963 | should not be read after 'c' is first modified. */ |
| 734 | argument should be evaluated more than once; side effects are | 964 | LISP_INLINE void |
| 735 | especially common in the second argument. */ | 965 | XSETCAR (Lisp_Object c, Lisp_Object n) |
| 736 | #define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n)) | 966 | { |
| 737 | #define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n)) | 967 | *xcar_addr (c) = n; |
| 968 | } | ||
| 969 | LISP_INLINE void | ||
| 970 | XSETCDR (Lisp_Object c, Lisp_Object n) | ||
| 971 | { | ||
| 972 | *xcdr_addr (c) = n; | ||
| 973 | } | ||
| 738 | 974 | ||
| 739 | /* Take the car or cdr of something whose type is not known. */ | 975 | /* Take the car or cdr of something whose type is not known. */ |
| 740 | #define CAR(c) \ | 976 | LISP_INLINE Lisp_Object |
| 741 | (CONSP ((c)) ? XCAR ((c)) \ | 977 | CAR (Lisp_Object c) |
| 742 | : NILP ((c)) ? Qnil \ | 978 | { |
| 743 | : wrong_type_argument (Qlistp, (c))) | 979 | return (CONSP (c) ? XCAR (c) |
| 744 | 980 | : NILP (c) ? Qnil | |
| 745 | #define CDR(c) \ | 981 | : wrong_type_argument (Qlistp, c)); |
| 746 | (CONSP ((c)) ? XCDR ((c)) \ | 982 | } |
| 747 | : NILP ((c)) ? Qnil \ | 983 | LISP_INLINE Lisp_Object |
| 748 | : wrong_type_argument (Qlistp, (c))) | 984 | CDR (Lisp_Object c) |
| 985 | { | ||
| 986 | return (CONSP (c) ? XCDR (c) | ||
| 987 | : NILP (c) ? Qnil | ||
| 988 | : wrong_type_argument (Qlistp, c)); | ||
| 989 | } | ||
| 749 | 990 | ||
| 750 | /* Take the car or cdr of something whose type is not known. */ | 991 | /* Take the car or cdr of something whose type is not known. */ |
| 751 | #define CAR_SAFE(c) \ | 992 | LISP_INLINE Lisp_Object |
| 752 | (CONSP ((c)) ? XCAR ((c)) : Qnil) | 993 | CAR_SAFE (Lisp_Object c) |
| 753 | 994 | { | |
| 754 | #define CDR_SAFE(c) \ | 995 | return CONSP (c) ? XCAR (c) : Qnil; |
| 755 | (CONSP ((c)) ? XCDR ((c)) : Qnil) | 996 | } |
| 756 | 997 | LISP_INLINE Lisp_Object | |
| 757 | /* True if STR is a multibyte string. */ | 998 | CDR_SAFE (Lisp_Object c) |
| 758 | #define STRING_MULTIBYTE(STR) \ | 999 | { |
| 759 | (XSTRING (STR)->size_byte >= 0) | 1000 | return CONSP (c) ? XCDR (c) : Qnil; |
| 760 | 1001 | } | |
| 761 | /* Return the length in bytes of STR. */ | ||
| 762 | |||
| 763 | #ifdef GC_CHECK_STRING_BYTES | ||
| 764 | |||
| 765 | struct Lisp_String; | ||
| 766 | extern ptrdiff_t string_bytes (struct Lisp_String *); | ||
| 767 | #define STRING_BYTES(S) string_bytes ((S)) | ||
| 768 | 1002 | ||
| 769 | #else /* not GC_CHECK_STRING_BYTES */ | 1003 | /* In a string or vector, the sign bit of the `size' is the gc mark bit. */ |
| 770 | 1004 | ||
| 771 | #define STRING_BYTES(STR) \ | 1005 | struct Lisp_String |
| 772 | ((STR)->size_byte < 0 ? (STR)->size : (STR)->size_byte) | 1006 | { |
| 1007 | ptrdiff_t size; | ||
| 1008 | ptrdiff_t size_byte; | ||
| 1009 | INTERVAL intervals; /* Text properties in this string. */ | ||
| 1010 | unsigned char *data; | ||
| 1011 | }; | ||
| 773 | 1012 | ||
| 774 | #endif /* not GC_CHECK_STRING_BYTES */ | 1013 | /* True if STR is a multibyte string. */ |
| 1014 | LISP_INLINE bool | ||
| 1015 | STRING_MULTIBYTE (Lisp_Object str) | ||
| 1016 | { | ||
| 1017 | return 0 <= XSTRING (str)->size_byte; | ||
| 1018 | } | ||
| 775 | 1019 | ||
| 776 | /* An upper bound on the number of bytes in a Lisp string, not | 1020 | /* An upper bound on the number of bytes in a Lisp string, not |
| 777 | counting the terminating null. This a tight enough bound to | 1021 | counting the terminating null. This a tight enough bound to |
| @@ -802,20 +1046,65 @@ extern ptrdiff_t string_bytes (struct Lisp_String *); | |||
| 802 | (STR) = empty_multibyte_string; \ | 1046 | (STR) = empty_multibyte_string; \ |
| 803 | else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) | 1047 | else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) |
| 804 | 1048 | ||
| 805 | /* In a string or vector, the sign bit of the `size' is the gc mark bit. */ | 1049 | /* Convenience functions for dealing with Lisp strings. */ |
| 806 | 1050 | ||
| 807 | struct Lisp_String | 1051 | LISP_INLINE unsigned char * |
| 808 | { | 1052 | SDATA (Lisp_Object string) |
| 809 | ptrdiff_t size; | 1053 | { |
| 810 | ptrdiff_t size_byte; | 1054 | return XSTRING (string)->data; |
| 811 | INTERVAL intervals; /* Text properties in this string. */ | 1055 | } |
| 812 | unsigned char *data; | 1056 | LISP_INLINE char * |
| 813 | }; | 1057 | SSDATA (Lisp_Object string) |
| 1058 | { | ||
| 1059 | /* Avoid "differ in sign" warnings. */ | ||
| 1060 | return (char *) SDATA (string); | ||
| 1061 | } | ||
| 1062 | LISP_INLINE unsigned char | ||
| 1063 | SREF (Lisp_Object string, ptrdiff_t index) | ||
| 1064 | { | ||
| 1065 | return SDATA (string)[index]; | ||
| 1066 | } | ||
| 1067 | LISP_INLINE void | ||
| 1068 | SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) | ||
| 1069 | { | ||
| 1070 | SDATA (string)[index] = new; | ||
| 1071 | } | ||
| 1072 | LISP_INLINE ptrdiff_t | ||
| 1073 | SCHARS (Lisp_Object string) | ||
| 1074 | { | ||
| 1075 | return XSTRING (string)->size; | ||
| 1076 | } | ||
| 1077 | LISP_INLINE ptrdiff_t | ||
| 1078 | STRING_BYTES (struct Lisp_String *s) | ||
| 1079 | { | ||
| 1080 | #ifdef GC_CHECK_STRING_BYTES | ||
| 1081 | extern ptrdiff_t string_bytes (struct Lisp_String *); | ||
| 1082 | return string_bytes (s); | ||
| 1083 | #else | ||
| 1084 | return s->size_byte < 0 ? s->size : s->size_byte; | ||
| 1085 | #endif | ||
| 1086 | } | ||
| 1087 | LISP_INLINE ptrdiff_t | ||
| 1088 | SBYTES (Lisp_Object string) | ||
| 1089 | { | ||
| 1090 | return STRING_BYTES (XSTRING (string)); | ||
| 1091 | } | ||
| 1092 | LISP_INLINE void | ||
| 1093 | STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) | ||
| 1094 | { | ||
| 1095 | XSTRING (string)->size = newsize; | ||
| 1096 | } | ||
| 1097 | LISP_INLINE void | ||
| 1098 | STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, | ||
| 1099 | ptrdiff_t count) | ||
| 1100 | { | ||
| 1101 | memcpy (SDATA (string) + index, new, count); | ||
| 1102 | } | ||
| 814 | 1103 | ||
| 815 | /* Header of vector-like objects. This documents the layout constraints on | 1104 | /* Header of vector-like objects. This documents the layout constraints on |
| 816 | vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents | 1105 | vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents |
| 817 | compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR | 1106 | compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR |
| 818 | and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, | 1107 | and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, |
| 819 | because when two such pointers potentially alias, a compiler won't | 1108 | because when two such pointers potentially alias, a compiler won't |
| 820 | incorrectly reorder loads and stores to their size fields. See | 1109 | incorrectly reorder loads and stores to their size fields. See |
| 821 | <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ | 1110 | <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ |
| @@ -874,6 +1163,42 @@ enum | |||
| 874 | word_size = sizeof (Lisp_Object) | 1163 | word_size = sizeof (Lisp_Object) |
| 875 | }; | 1164 | }; |
| 876 | 1165 | ||
| 1166 | /* Conveniences for dealing with Lisp arrays. */ | ||
| 1167 | |||
| 1168 | LISP_INLINE Lisp_Object | ||
| 1169 | AREF (Lisp_Object array, ptrdiff_t idx) | ||
| 1170 | { | ||
| 1171 | return XVECTOR (array)->contents[idx]; | ||
| 1172 | } | ||
| 1173 | |||
| 1174 | LISP_INLINE Lisp_Object * | ||
| 1175 | aref_addr (Lisp_Object array, ptrdiff_t idx) | ||
| 1176 | { | ||
| 1177 | return & XVECTOR (array)->contents[idx]; | ||
| 1178 | } | ||
| 1179 | |||
| 1180 | LISP_INLINE ptrdiff_t | ||
| 1181 | ASIZE (Lisp_Object array) | ||
| 1182 | { | ||
| 1183 | return XVECTOR (array)->header.size; | ||
| 1184 | } | ||
| 1185 | |||
| 1186 | LISP_INLINE void | ||
| 1187 | ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) | ||
| 1188 | { | ||
| 1189 | eassert (0 <= idx && idx < ASIZE (array)); | ||
| 1190 | XVECTOR (array)->contents[idx] = val; | ||
| 1191 | } | ||
| 1192 | |||
| 1193 | LISP_INLINE void | ||
| 1194 | gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) | ||
| 1195 | { | ||
| 1196 | /* Like ASET, but also can be used in the garbage collector: | ||
| 1197 | sweep_weak_table calls set_hash_key etc. while the table is marked. */ | ||
| 1198 | eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); | ||
| 1199 | XVECTOR (array)->contents[idx] = val; | ||
| 1200 | } | ||
| 1201 | |||
| 877 | /* If a struct is made to look like a vector, this macro returns the length | 1202 | /* If a struct is made to look like a vector, this macro returns the length |
| 878 | of the shortest vector that would hold that struct. */ | 1203 | of the shortest vector that would hold that struct. */ |
| 879 | 1204 | ||
| @@ -887,43 +1212,6 @@ enum | |||
| 887 | #define PSEUDOVECSIZE(type, nonlispfield) \ | 1212 | #define PSEUDOVECSIZE(type, nonlispfield) \ |
| 888 | ((offsetof (type, nonlispfield) - header_size) / word_size) | 1213 | ((offsetof (type, nonlispfield) - header_size) / word_size) |
| 889 | 1214 | ||
| 890 | /* A char-table is a kind of vectorlike, with contents are like a | ||
| 891 | vector but with a few other slots. For some purposes, it makes | ||
| 892 | sense to handle a char-table with type struct Lisp_Vector. An | ||
| 893 | element of a char table can be any Lisp objects, but if it is a sub | ||
| 894 | char-table, we treat it a table that contains information of a | ||
| 895 | specific range of characters. A sub char-table has the same | ||
| 896 | structure as a vector. A sub char table appears only in an element | ||
| 897 | of a char-table, and there's no way to access it directly from | ||
| 898 | Emacs Lisp program. */ | ||
| 899 | |||
| 900 | #ifdef __GNUC__ | ||
| 901 | |||
| 902 | #define CHAR_TABLE_REF_ASCII(CT, IDX) \ | ||
| 903 | ({struct Lisp_Char_Table *_tbl = NULL; \ | ||
| 904 | Lisp_Object _val; \ | ||
| 905 | do { \ | ||
| 906 | _tbl = _tbl ? XCHAR_TABLE (_tbl->parent) : XCHAR_TABLE (CT); \ | ||
| 907 | _val = (! SUB_CHAR_TABLE_P (_tbl->ascii) ? _tbl->ascii \ | ||
| 908 | : XSUB_CHAR_TABLE (_tbl->ascii)->contents[IDX]); \ | ||
| 909 | if (NILP (_val)) \ | ||
| 910 | _val = _tbl->defalt; \ | ||
| 911 | } while (NILP (_val) && ! NILP (_tbl->parent)); \ | ||
| 912 | _val; }) | ||
| 913 | |||
| 914 | #else /* not __GNUC__ */ | ||
| 915 | |||
| 916 | #define CHAR_TABLE_REF_ASCII(CT, IDX) \ | ||
| 917 | (! NILP (XCHAR_TABLE (CT)->ascii) \ | ||
| 918 | ? (! SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ | ||
| 919 | ? XCHAR_TABLE (CT)->ascii \ | ||
| 920 | : ! NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX]) \ | ||
| 921 | ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ | ||
| 922 | : char_table_ref ((CT), (IDX))) \ | ||
| 923 | : char_table_ref ((CT), (IDX))) | ||
| 924 | |||
| 925 | #endif /* not __GNUC__ */ | ||
| 926 | |||
| 927 | /* Compute A OP B, using the unsigned comparison operator OP. A and B | 1215 | /* Compute A OP B, using the unsigned comparison operator OP. A and B |
| 928 | should be integer expressions. This is not the same as | 1216 | should be integer expressions. This is not the same as |
| 929 | mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) | 1217 | mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) |
| @@ -937,18 +1225,15 @@ enum | |||
| 937 | /* Nonzero iff C is an ASCII character. */ | 1225 | /* Nonzero iff C is an ASCII character. */ |
| 938 | #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) | 1226 | #define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) |
| 939 | 1227 | ||
| 940 | /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII | 1228 | /* A char-table is a kind of vectorlike, with contents are like a |
| 941 | characters. Do not check validity of CT. */ | 1229 | vector but with a few other slots. For some purposes, it makes |
| 942 | #define CHAR_TABLE_REF(CT, IDX) \ | 1230 | sense to handle a char-table with type struct Lisp_Vector. An |
| 943 | (ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \ | 1231 | element of a char table can be any Lisp objects, but if it is a sub |
| 944 | : char_table_ref ((CT), (IDX))) | 1232 | char-table, we treat it a table that contains information of a |
| 945 | 1233 | specific range of characters. A sub char-table has the same | |
| 946 | /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and | 1234 | structure as a vector. A sub char table appears only in an element |
| 947 | 8-bit European characters. Do not check validity of CT. */ | 1235 | of a char-table, and there's no way to access it directly from |
| 948 | #define CHAR_TABLE_SET(CT, IDX, VAL) \ | 1236 | Emacs Lisp program. */ |
| 949 | (ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ | ||
| 950 | ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \ | ||
| 951 | : char_table_set (CT, IDX, VAL)) | ||
| 952 | 1237 | ||
| 953 | enum CHARTAB_SIZE_BITS | 1238 | enum CHARTAB_SIZE_BITS |
| 954 | { | 1239 | { |
| @@ -1012,6 +1297,45 @@ struct Lisp_Sub_Char_Table | |||
| 1012 | Lisp_Object contents[1]; | 1297 | Lisp_Object contents[1]; |
| 1013 | }; | 1298 | }; |
| 1014 | 1299 | ||
| 1300 | LISP_INLINE Lisp_Object | ||
| 1301 | CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) | ||
| 1302 | { | ||
| 1303 | struct Lisp_Char_Table *tbl = NULL; | ||
| 1304 | Lisp_Object val; | ||
| 1305 | do | ||
| 1306 | { | ||
| 1307 | tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); | ||
| 1308 | val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii | ||
| 1309 | : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); | ||
| 1310 | if (NILP (val)) | ||
| 1311 | val = tbl->defalt; | ||
| 1312 | } | ||
| 1313 | while (NILP (val) && ! NILP (tbl->parent)); | ||
| 1314 | |||
| 1315 | return val; | ||
| 1316 | } | ||
| 1317 | |||
| 1318 | /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII | ||
| 1319 | characters. Do not check validity of CT. */ | ||
| 1320 | LISP_INLINE Lisp_Object | ||
| 1321 | CHAR_TABLE_REF (Lisp_Object ct, int idx) | ||
| 1322 | { | ||
| 1323 | return (ASCII_CHAR_P (idx) | ||
| 1324 | ? CHAR_TABLE_REF_ASCII (ct, idx) | ||
| 1325 | : char_table_ref (ct, idx)); | ||
| 1326 | } | ||
| 1327 | |||
| 1328 | /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and | ||
| 1329 | 8-bit European characters. Do not check validity of CT. */ | ||
| 1330 | LISP_INLINE void | ||
| 1331 | CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) | ||
| 1332 | { | ||
| 1333 | if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii)) | ||
| 1334 | set_sub_char_table_contents (XCHAR_TABLE (ct)->ascii, idx, val); | ||
| 1335 | else | ||
| 1336 | char_table_set (ct, idx, val); | ||
| 1337 | } | ||
| 1338 | |||
| 1015 | /* This structure describes a built-in function. | 1339 | /* This structure describes a built-in function. |
| 1016 | It is generated by the DEFUN macro only. | 1340 | It is generated by the DEFUN macro only. |
| 1017 | defsubr makes it into a Lisp object. */ | 1341 | defsubr makes it into a Lisp object. */ |
| @@ -1048,8 +1372,12 @@ enum CHAR_TABLE_STANDARD_SLOTS | |||
| 1048 | 1372 | ||
| 1049 | /* Return the number of "extra" slots in the char table CT. */ | 1373 | /* Return the number of "extra" slots in the char table CT. */ |
| 1050 | 1374 | ||
| 1051 | #define CHAR_TABLE_EXTRA_SLOTS(CT) \ | 1375 | LISP_INLINE int |
| 1052 | (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) | 1376 | CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) |
| 1377 | { | ||
| 1378 | return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK) | ||
| 1379 | - CHAR_TABLE_STANDARD_SLOTS); | ||
| 1380 | } | ||
| 1053 | 1381 | ||
| 1054 | 1382 | ||
| 1055 | /*********************************************************************** | 1383 | /*********************************************************************** |
| @@ -1121,40 +1449,76 @@ struct Lisp_Symbol | |||
| 1121 | 1449 | ||
| 1122 | /* Value is name of symbol. */ | 1450 | /* Value is name of symbol. */ |
| 1123 | 1451 | ||
| 1124 | #define SYMBOL_VAL(sym) \ | 1452 | LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) |
| 1125 | (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) | 1453 | |
| 1126 | #define SYMBOL_ALIAS(sym) \ | 1454 | LISP_INLINE struct Lisp_Symbol * |
| 1127 | (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) | 1455 | SYMBOL_ALIAS (struct Lisp_Symbol *sym) |
| 1128 | #define SYMBOL_BLV(sym) \ | 1456 | { |
| 1129 | (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) | 1457 | eassert (sym->redirect == SYMBOL_VARALIAS); |
| 1130 | #define SYMBOL_FWD(sym) \ | 1458 | return sym->val.alias; |
| 1131 | (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) | 1459 | } |
| 1132 | #define SET_SYMBOL_VAL(sym, v) \ | 1460 | LISP_INLINE struct Lisp_Buffer_Local_Value * |
| 1133 | (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) | 1461 | SYMBOL_BLV (struct Lisp_Symbol *sym) |
| 1134 | #define SET_SYMBOL_ALIAS(sym, v) \ | 1462 | { |
| 1135 | (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) | 1463 | eassert (sym->redirect == SYMBOL_LOCALIZED); |
| 1136 | #define SET_SYMBOL_BLV(sym, v) \ | 1464 | return sym->val.blv; |
| 1137 | (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) | 1465 | } |
| 1138 | #define SET_SYMBOL_FWD(sym, v) \ | 1466 | LISP_INLINE union Lisp_Fwd * |
| 1139 | (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) | 1467 | SYMBOL_FWD (struct Lisp_Symbol *sym) |
| 1468 | { | ||
| 1469 | eassert (sym->redirect == SYMBOL_FORWARDED); | ||
| 1470 | return sym->val.fwd; | ||
| 1471 | } | ||
| 1472 | |||
| 1473 | LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL, | ||
| 1474 | (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v)) | ||
| 1475 | |||
| 1476 | LISP_INLINE void | ||
| 1477 | SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) | ||
| 1478 | { | ||
| 1479 | eassert (sym->redirect == SYMBOL_VARALIAS); | ||
| 1480 | sym->val.alias = v; | ||
| 1481 | } | ||
| 1482 | LISP_INLINE void | ||
| 1483 | SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) | ||
| 1484 | { | ||
| 1485 | eassert (sym->redirect == SYMBOL_LOCALIZED); | ||
| 1486 | sym->val.blv = v; | ||
| 1487 | } | ||
| 1488 | LISP_INLINE void | ||
| 1489 | SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) | ||
| 1490 | { | ||
| 1491 | eassert (sym->redirect == SYMBOL_FORWARDED); | ||
| 1492 | sym->val.fwd = v; | ||
| 1493 | } | ||
| 1140 | 1494 | ||
| 1141 | #define SYMBOL_NAME(sym) XSYMBOL (sym)->name | 1495 | LISP_INLINE Lisp_Object |
| 1496 | SYMBOL_NAME (Lisp_Object sym) | ||
| 1497 | { | ||
| 1498 | return XSYMBOL (sym)->name; | ||
| 1499 | } | ||
| 1142 | 1500 | ||
| 1143 | /* Value is non-zero if SYM is an interned symbol. */ | 1501 | /* Value is true if SYM is an interned symbol. */ |
| 1144 | 1502 | ||
| 1145 | #define SYMBOL_INTERNED_P(sym) \ | 1503 | LISP_INLINE bool |
| 1146 | (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) | 1504 | SYMBOL_INTERNED_P (Lisp_Object sym) |
| 1505 | { | ||
| 1506 | return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; | ||
| 1507 | } | ||
| 1147 | 1508 | ||
| 1148 | /* Value is non-zero if SYM is interned in initial_obarray. */ | 1509 | /* Value is true if SYM is interned in initial_obarray. */ |
| 1149 | 1510 | ||
| 1150 | #define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ | 1511 | LISP_INLINE bool |
| 1151 | (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) | 1512 | SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) |
| 1513 | { | ||
| 1514 | return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; | ||
| 1515 | } | ||
| 1152 | 1516 | ||
| 1153 | /* Value is non-zero if symbol is considered a constant, i.e. its | 1517 | /* Value is non-zero if symbol is considered a constant, i.e. its |
| 1154 | value cannot be changed (there is an exception for keyword symbols, | 1518 | value cannot be changed (there is an exception for keyword symbols, |
| 1155 | whose value can be set to the keyword symbol itself). */ | 1519 | whose value can be set to the keyword symbol itself). */ |
| 1156 | 1520 | ||
| 1157 | #define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant | 1521 | LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) |
| 1158 | 1522 | ||
| 1159 | #define DEFSYM(sym, name) \ | 1523 | #define DEFSYM(sym, name) \ |
| 1160 | do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) | 1524 | do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) |
| @@ -1240,42 +1604,64 @@ struct Lisp_Hash_Table | |||
| 1240 | }; | 1604 | }; |
| 1241 | 1605 | ||
| 1242 | 1606 | ||
| 1243 | #define XHASH_TABLE(OBJ) \ | 1607 | LISP_INLINE struct Lisp_Hash_Table * |
| 1244 | ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) | 1608 | XHASH_TABLE (Lisp_Object a) |
| 1609 | { | ||
| 1610 | return XUNTAG (a, Lisp_Vectorlike); | ||
| 1611 | } | ||
| 1245 | 1612 | ||
| 1246 | #define XSET_HASH_TABLE(VAR, PTR) \ | 1613 | #define XSET_HASH_TABLE(VAR, PTR) \ |
| 1247 | (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) | 1614 | (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) |
| 1248 | 1615 | ||
| 1249 | #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) | 1616 | LISP_INLINE bool |
| 1250 | 1617 | HASH_TABLE_P (Lisp_Object a) | |
| 1251 | #define CHECK_HASH_TABLE(x) \ | 1618 | { |
| 1252 | CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) | 1619 | return PSEUDOVECTORP (a, PVEC_HASH_TABLE); |
| 1620 | } | ||
| 1253 | 1621 | ||
| 1254 | /* Value is the key part of entry IDX in hash table H. */ | 1622 | /* Value is the key part of entry IDX in hash table H. */ |
| 1255 | 1623 | LISP_INLINE Lisp_Object | |
| 1256 | #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) | 1624 | HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 1625 | { | ||
| 1626 | return AREF (h->key_and_value, 2 * idx); | ||
| 1627 | } | ||
| 1257 | 1628 | ||
| 1258 | /* Value is the value part of entry IDX in hash table H. */ | 1629 | /* Value is the value part of entry IDX in hash table H. */ |
| 1259 | 1630 | LISP_INLINE Lisp_Object | |
| 1260 | #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) | 1631 | HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 1632 | { | ||
| 1633 | return AREF (h->key_and_value, 2 * idx + 1); | ||
| 1634 | } | ||
| 1261 | 1635 | ||
| 1262 | /* Value is the index of the next entry following the one at IDX | 1636 | /* Value is the index of the next entry following the one at IDX |
| 1263 | in hash table H. */ | 1637 | in hash table H. */ |
| 1264 | 1638 | LISP_INLINE Lisp_Object | |
| 1265 | #define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) | 1639 | HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 1640 | { | ||
| 1641 | return AREF (h->next, idx); | ||
| 1642 | } | ||
| 1266 | 1643 | ||
| 1267 | /* Value is the hash code computed for entry IDX in hash table H. */ | 1644 | /* Value is the hash code computed for entry IDX in hash table H. */ |
| 1268 | 1645 | LISP_INLINE Lisp_Object | |
| 1269 | #define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) | 1646 | HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 1647 | { | ||
| 1648 | return AREF (h->hash, idx); | ||
| 1649 | } | ||
| 1270 | 1650 | ||
| 1271 | /* Value is the index of the element in hash table H that is the | 1651 | /* Value is the index of the element in hash table H that is the |
| 1272 | start of the collision list at index IDX in the index vector of H. */ | 1652 | start of the collision list at index IDX in the index vector of H. */ |
| 1273 | 1653 | LISP_INLINE Lisp_Object | |
| 1274 | #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) | 1654 | HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) |
| 1655 | { | ||
| 1656 | return AREF (h->index, idx); | ||
| 1657 | } | ||
| 1275 | 1658 | ||
| 1276 | /* Value is the size of hash table H. */ | 1659 | /* Value is the size of hash table H. */ |
| 1277 | 1660 | LISP_INLINE ptrdiff_t | |
| 1278 | #define HASH_TABLE_SIZE(H) ASIZE ((H)->next) | 1661 | HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) |
| 1662 | { | ||
| 1663 | return ASIZE (h->next); | ||
| 1664 | } | ||
| 1279 | 1665 | ||
| 1280 | /* Default size for hash tables if not specified. */ | 1666 | /* Default size for hash tables if not specified. */ |
| 1281 | 1667 | ||
| @@ -1485,6 +1871,53 @@ struct Lisp_Save_Value | |||
| 1485 | } data[SAVE_VALUE_SLOTS]; | 1871 | } data[SAVE_VALUE_SLOTS]; |
| 1486 | }; | 1872 | }; |
| 1487 | 1873 | ||
| 1874 | /* Return the type of V's Nth saved value. */ | ||
| 1875 | LISP_INLINE int | ||
| 1876 | save_type (struct Lisp_Save_Value *v, int n) | ||
| 1877 | { | ||
| 1878 | eassert (0 <= n && n < SAVE_VALUE_SLOTS); | ||
| 1879 | return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); | ||
| 1880 | } | ||
| 1881 | |||
| 1882 | /* Get and set the Nth saved pointer. */ | ||
| 1883 | |||
| 1884 | LISP_INLINE void * | ||
| 1885 | XSAVE_POINTER (Lisp_Object obj, int n) | ||
| 1886 | { | ||
| 1887 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); | ||
| 1888 | return XSAVE_VALUE (obj)->data[n].pointer;; | ||
| 1889 | } | ||
| 1890 | LISP_INLINE void | ||
| 1891 | set_save_pointer (Lisp_Object obj, int n, void *val) | ||
| 1892 | { | ||
| 1893 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); | ||
| 1894 | XSAVE_VALUE (obj)->data[n].pointer = val; | ||
| 1895 | } | ||
| 1896 | |||
| 1897 | /* Likewise for the saved integer. */ | ||
| 1898 | |||
| 1899 | LISP_INLINE ptrdiff_t | ||
| 1900 | XSAVE_INTEGER (Lisp_Object obj, int n) | ||
| 1901 | { | ||
| 1902 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); | ||
| 1903 | return XSAVE_VALUE (obj)->data[n].integer; | ||
| 1904 | } | ||
| 1905 | LISP_INLINE void | ||
| 1906 | set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) | ||
| 1907 | { | ||
| 1908 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); | ||
| 1909 | XSAVE_VALUE (obj)->data[n].integer = val; | ||
| 1910 | } | ||
| 1911 | |||
| 1912 | /* Extract Nth saved object. */ | ||
| 1913 | |||
| 1914 | LISP_INLINE Lisp_Object | ||
| 1915 | XSAVE_OBJECT (Lisp_Object obj, int n) | ||
| 1916 | { | ||
| 1917 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); | ||
| 1918 | return XSAVE_VALUE (obj)->data[n].object; | ||
| 1919 | } | ||
| 1920 | |||
| 1488 | /* A miscellaneous object, when it's on the free list. */ | 1921 | /* A miscellaneous object, when it's on the free list. */ |
| 1489 | struct Lisp_Free | 1922 | struct Lisp_Free |
| 1490 | { | 1923 | { |
| @@ -1506,6 +1939,46 @@ union Lisp_Misc | |||
| 1506 | struct Lisp_Save_Value u_save_value; | 1939 | struct Lisp_Save_Value u_save_value; |
| 1507 | }; | 1940 | }; |
| 1508 | 1941 | ||
| 1942 | LISP_INLINE union Lisp_Misc * | ||
| 1943 | XMISC (Lisp_Object a) | ||
| 1944 | { | ||
| 1945 | return XUNTAG (a, Lisp_Misc); | ||
| 1946 | } | ||
| 1947 | |||
| 1948 | LISP_INLINE struct Lisp_Misc_Any * | ||
| 1949 | XMISCANY (Lisp_Object a) | ||
| 1950 | { | ||
| 1951 | eassert (MISCP (a)); | ||
| 1952 | return & XMISC (a)->u_any; | ||
| 1953 | } | ||
| 1954 | |||
| 1955 | LISP_INLINE enum Lisp_Misc_Type | ||
| 1956 | XMISCTYPE (Lisp_Object a) | ||
| 1957 | { | ||
| 1958 | return XMISCANY (a)->type; | ||
| 1959 | } | ||
| 1960 | |||
| 1961 | LISP_INLINE struct Lisp_Marker * | ||
| 1962 | XMARKER (Lisp_Object a) | ||
| 1963 | { | ||
| 1964 | eassert (MARKERP (a)); | ||
| 1965 | return & XMISC (a)->u_marker; | ||
| 1966 | } | ||
| 1967 | |||
| 1968 | LISP_INLINE struct Lisp_Overlay * | ||
| 1969 | XOVERLAY (Lisp_Object a) | ||
| 1970 | { | ||
| 1971 | eassert (OVERLAYP (a)); | ||
| 1972 | return & XMISC (a)->u_overlay; | ||
| 1973 | } | ||
| 1974 | |||
| 1975 | LISP_INLINE struct Lisp_Save_Value * | ||
| 1976 | XSAVE_VALUE (Lisp_Object a) | ||
| 1977 | { | ||
| 1978 | eassert (SAVE_VALUEP (a)); | ||
| 1979 | return & XMISC (a)->u_save_value; | ||
| 1980 | } | ||
| 1981 | |||
| 1509 | /* Forwarding pointer to an int variable. | 1982 | /* Forwarding pointer to an int variable. |
| 1510 | This is allowed only in the value cell of a symbol, | 1983 | This is allowed only in the value cell of a symbol, |
| 1511 | and it means that the symbol's value really lives in the | 1984 | and it means that the symbol's value really lives in the |
| @@ -1612,6 +2085,19 @@ union Lisp_Fwd | |||
| 1612 | struct Lisp_Buffer_Objfwd u_buffer_objfwd; | 2085 | struct Lisp_Buffer_Objfwd u_buffer_objfwd; |
| 1613 | struct Lisp_Kboard_Objfwd u_kboard_objfwd; | 2086 | struct Lisp_Kboard_Objfwd u_kboard_objfwd; |
| 1614 | }; | 2087 | }; |
| 2088 | |||
| 2089 | LISP_INLINE enum Lisp_Fwd_Type | ||
| 2090 | XFWDTYPE (union Lisp_Fwd *a) | ||
| 2091 | { | ||
| 2092 | return a->u_intfwd.type; | ||
| 2093 | } | ||
| 2094 | |||
| 2095 | LISP_INLINE struct Lisp_Buffer_Objfwd * | ||
| 2096 | XBUFFER_OBJFWD (union Lisp_Fwd *a) | ||
| 2097 | { | ||
| 2098 | eassert (BUFFER_OBJFWDP (a)); | ||
| 2099 | return &a->u_buffer_objfwd; | ||
| 2100 | } | ||
| 1615 | 2101 | ||
| 1616 | /* Lisp floating point type. */ | 2102 | /* Lisp floating point type. */ |
| 1617 | struct Lisp_Float | 2103 | struct Lisp_Float |
| @@ -1623,8 +2109,11 @@ struct Lisp_Float | |||
| 1623 | } u; | 2109 | } u; |
| 1624 | }; | 2110 | }; |
| 1625 | 2111 | ||
| 1626 | #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) | 2112 | LISP_INLINE double |
| 1627 | #define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) | 2113 | XFLOAT_DATA (Lisp_Object f) |
| 2114 | { | ||
| 2115 | return XFLOAT (f)->u.data; | ||
| 2116 | } | ||
| 1628 | 2117 | ||
| 1629 | /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 | 2118 | /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 |
| 1630 | representations, have infinities and NaNs, and do not trap on | 2119 | representations, have infinities and NaNs, and do not trap on |
| @@ -1633,8 +2122,12 @@ struct Lisp_Float | |||
| 1633 | wanted here, but is not quite right because Emacs does not require | 2122 | wanted here, but is not quite right because Emacs does not require |
| 1634 | all the features of C11 Annex F (and does not require C11 at all, | 2123 | all the features of C11 Annex F (and does not require C11 at all, |
| 1635 | for that matter). */ | 2124 | for that matter). */ |
| 1636 | #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ | 2125 | enum |
| 1637 | && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) | 2126 | { |
| 2127 | IEEE_FLOATING_POINT | ||
| 2128 | = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 | ||
| 2129 | && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) | ||
| 2130 | }; | ||
| 1638 | 2131 | ||
| 1639 | /* A character, declared with the following typedef, is a member | 2132 | /* A character, declared with the following typedef, is a member |
| 1640 | of some character set associated with the current buffer. */ | 2133 | of some character set associated with the current buffer. */ |
| @@ -1675,64 +2168,6 @@ enum char_bits | |||
| 1675 | itself. */ | 2168 | itself. */ |
| 1676 | CHARACTERBITS = 22 | 2169 | CHARACTERBITS = 22 |
| 1677 | }; | 2170 | }; |
| 1678 | |||
| 1679 | |||
| 1680 | |||
| 1681 | |||
| 1682 | /* The glyph datatype, used to represent characters on the display. | ||
| 1683 | It consists of a char code and a face id. */ | ||
| 1684 | |||
| 1685 | typedef struct { | ||
| 1686 | int ch; | ||
| 1687 | int face_id; | ||
| 1688 | } GLYPH; | ||
| 1689 | |||
| 1690 | /* Return a glyph's character code. */ | ||
| 1691 | #define GLYPH_CHAR(glyph) ((glyph).ch) | ||
| 1692 | |||
| 1693 | /* Return a glyph's face ID. */ | ||
| 1694 | #define GLYPH_FACE(glyph) ((glyph).face_id) | ||
| 1695 | |||
| 1696 | #define SET_GLYPH_CHAR(glyph, char) ((glyph).ch = (char)) | ||
| 1697 | #define SET_GLYPH_FACE(glyph, face) ((glyph).face_id = (face)) | ||
| 1698 | #define SET_GLYPH(glyph, char, face) ((glyph).ch = (char), (glyph).face_id = (face)) | ||
| 1699 | |||
| 1700 | /* Return 1 if GLYPH contains valid character code. */ | ||
| 1701 | #define GLYPH_CHAR_VALID_P(glyph) CHAR_VALID_P (GLYPH_CHAR (glyph)) | ||
| 1702 | |||
| 1703 | |||
| 1704 | /* Glyph Code from a display vector may either be an integer which | ||
| 1705 | encodes a char code in the lower CHARACTERBITS bits and a (very small) | ||
| 1706 | face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */ | ||
| 1707 | |||
| 1708 | #define GLYPH_CODE_P(gc) \ | ||
| 1709 | (CONSP (gc) \ | ||
| 1710 | ? (CHARACTERP (XCAR (gc)) \ | ||
| 1711 | && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \ | ||
| 1712 | : (RANGED_INTEGERP \ | ||
| 1713 | (0, gc, \ | ||
| 1714 | (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \ | ||
| 1715 | ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \ | ||
| 1716 | : TYPE_MAXIMUM (EMACS_INT))))) | ||
| 1717 | |||
| 1718 | /* The following are valid only if GLYPH_CODE_P (gc). */ | ||
| 1719 | |||
| 1720 | #define GLYPH_CODE_CHAR(gc) \ | ||
| 1721 | (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1)) | ||
| 1722 | |||
| 1723 | #define GLYPH_CODE_FACE(gc) \ | ||
| 1724 | (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS) | ||
| 1725 | |||
| 1726 | #define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \ | ||
| 1727 | do \ | ||
| 1728 | { \ | ||
| 1729 | if (CONSP (gc)) \ | ||
| 1730 | SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \ | ||
| 1731 | else \ | ||
| 1732 | SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \ | ||
| 1733 | (XINT (gc) >> CHARACTERBITS)); \ | ||
| 1734 | } \ | ||
| 1735 | while (0) | ||
| 1736 | 2171 | ||
| 1737 | /* Structure to hold mouse highlight data. This is here because other | 2172 | /* Structure to hold mouse highlight data. This is here because other |
| 1738 | header files need it for defining struct x_output etc. */ | 2173 | header files need it for defining struct x_output etc. */ |
| @@ -1768,190 +2203,235 @@ typedef struct { | |||
| 1768 | 2203 | ||
| 1769 | /* Data type checking. */ | 2204 | /* Data type checking. */ |
| 1770 | 2205 | ||
| 1771 | #define NILP(x) EQ (x, Qnil) | 2206 | LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x)) |
| 1772 | |||
| 1773 | #define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) | ||
| 1774 | #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) | ||
| 1775 | |||
| 1776 | #define RANGED_INTEGERP(lo, x, hi) \ | ||
| 1777 | (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) | ||
| 1778 | #define TYPE_RANGED_INTEGERP(type, x) \ | ||
| 1779 | (TYPE_SIGNED (type) \ | ||
| 1780 | ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ | ||
| 1781 | : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) | ||
| 1782 | |||
| 1783 | #define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) | ||
| 1784 | #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) | ||
| 1785 | #define MISCP(x) (XTYPE ((x)) == Lisp_Misc) | ||
| 1786 | #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) | ||
| 1787 | #define STRINGP(x) (XTYPE ((x)) == Lisp_String) | ||
| 1788 | #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) | ||
| 1789 | |||
| 1790 | #define FLOATP(x) (XTYPE ((x)) == Lisp_Float) | ||
| 1791 | #define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) | ||
| 1792 | #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) | ||
| 1793 | #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) | ||
| 1794 | 2207 | ||
| 1795 | LISP_INLINE bool | 2208 | LISP_INLINE bool |
| 1796 | SAVE_VALUEP (Lisp_Object x) | 2209 | NUMBERP (Lisp_Object x) |
| 1797 | { | 2210 | { |
| 1798 | return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; | 2211 | return INTEGERP (x) || FLOATP (x); |
| 1799 | } | 2212 | } |
| 1800 | 2213 | LISP_INLINE bool | |
| 1801 | LISP_INLINE struct Lisp_Save_Value * | 2214 | NATNUMP (Lisp_Object x) |
| 1802 | XSAVE_VALUE (Lisp_Object a) | ||
| 1803 | { | 2215 | { |
| 1804 | eassert (SAVE_VALUEP (a)); | 2216 | return INTEGERP (x) && 0 <= XINT (x); |
| 1805 | return & XMISC (a)->u_save_value; | ||
| 1806 | } | 2217 | } |
| 1807 | 2218 | ||
| 1808 | /* Return the type of V's Nth saved value. */ | 2219 | LISP_INLINE bool |
| 1809 | LISP_INLINE int | 2220 | RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) |
| 1810 | save_type (struct Lisp_Save_Value *v, int n) | ||
| 1811 | { | 2221 | { |
| 1812 | eassert (0 <= n && n < SAVE_VALUE_SLOTS); | 2222 | return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; |
| 1813 | return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); | ||
| 1814 | } | 2223 | } |
| 1815 | 2224 | ||
| 1816 | /* Get and set the Nth saved pointer. */ | 2225 | #define TYPE_RANGED_INTEGERP(type, x) \ |
| 2226 | (INTEGERP (x) \ | ||
| 2227 | && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ | ||
| 2228 | && XINT (x) <= TYPE_MAXIMUM (type)) | ||
| 2229 | |||
| 2230 | LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x)) | ||
| 2231 | LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x)) | ||
| 2232 | LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x)) | ||
| 2233 | LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x)) | ||
| 2234 | LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x)) | ||
| 2235 | LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x)) | ||
| 2236 | LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x)) | ||
| 1817 | 2237 | ||
| 1818 | LISP_INLINE void * | 2238 | LISP_INLINE bool |
| 1819 | XSAVE_POINTER (Lisp_Object obj, int n) | 2239 | STRINGP (Lisp_Object x) |
| 1820 | { | 2240 | { |
| 1821 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); | 2241 | return XTYPE (x) == Lisp_String; |
| 1822 | return XSAVE_VALUE (obj)->data[n].pointer;; | ||
| 1823 | } | 2242 | } |
| 1824 | LISP_INLINE void | 2243 | LISP_INLINE bool |
| 1825 | set_save_pointer (Lisp_Object obj, int n, void *val) | 2244 | VECTORP (Lisp_Object x) |
| 1826 | { | 2245 | { |
| 1827 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); | 2246 | return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); |
| 1828 | XSAVE_VALUE (obj)->data[n].pointer = val; | ||
| 1829 | } | 2247 | } |
| 1830 | 2248 | LISP_INLINE bool | |
| 1831 | /* Likewise for the saved integer. */ | 2249 | OVERLAYP (Lisp_Object x) |
| 1832 | |||
| 1833 | LISP_INLINE ptrdiff_t | ||
| 1834 | XSAVE_INTEGER (Lisp_Object obj, int n) | ||
| 1835 | { | 2250 | { |
| 1836 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); | 2251 | return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; |
| 1837 | return XSAVE_VALUE (obj)->data[n].integer; | ||
| 1838 | } | 2252 | } |
| 1839 | LISP_INLINE void | 2253 | LISP_INLINE bool |
| 1840 | set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) | 2254 | SAVE_VALUEP (Lisp_Object x) |
| 1841 | { | 2255 | { |
| 1842 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); | 2256 | return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; |
| 1843 | XSAVE_VALUE (obj)->data[n].integer = val; | ||
| 1844 | } | 2257 | } |
| 1845 | 2258 | ||
| 1846 | /* Extract Nth saved object. */ | 2259 | LISP_INLINE bool |
| 1847 | 2260 | AUTOLOADP (Lisp_Object x) | |
| 1848 | LISP_INLINE Lisp_Object | ||
| 1849 | XSAVE_OBJECT (Lisp_Object obj, int n) | ||
| 1850 | { | 2261 | { |
| 1851 | eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); | 2262 | return CONSP (x) && EQ (Qautoload, XCAR (x)); |
| 1852 | return XSAVE_VALUE (obj)->data[n].object; | ||
| 1853 | } | 2263 | } |
| 1854 | 2264 | ||
| 1855 | #define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) | 2265 | LISP_INLINE bool |
| 1856 | 2266 | BUFFER_OBJFWDP (union Lisp_Fwd *a) | |
| 1857 | #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) | 2267 | { |
| 1858 | #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) | 2268 | return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; |
| 1859 | #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) | 2269 | } |
| 1860 | #define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) | ||
| 1861 | #define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) | ||
| 1862 | 2270 | ||
| 1863 | /* True if object X is a pseudovector whose code is CODE. The cast to struct | 2271 | LISP_INLINE bool |
| 1864 | vectorlike_header * avoids aliasing issues. */ | 2272 | PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) |
| 1865 | #define PSEUDOVECTORP(x, code) \ | 2273 | { |
| 1866 | TYPED_PSEUDOVECTORP (x, vectorlike_header, code) | 2274 | return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) |
| 2275 | == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); | ||
| 2276 | } | ||
| 1867 | 2277 | ||
| 1868 | #define PSEUDOVECTOR_TYPEP(v, code) \ | 2278 | /* True if A is a pseudovector whose code is CODE. */ |
| 1869 | (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ | 2279 | LISP_INLINE bool |
| 1870 | == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) | 2280 | PSEUDOVECTORP (Lisp_Object a, int code) |
| 2281 | { | ||
| 2282 | if (! VECTORLIKEP (a)) | ||
| 2283 | return 0; | ||
| 2284 | else | ||
| 2285 | { | ||
| 2286 | /* Converting to struct vectorlike_header * avoids aliasing issues. */ | ||
| 2287 | struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); | ||
| 2288 | return PSEUDOVECTOR_TYPEP (h, code); | ||
| 2289 | } | ||
| 2290 | } | ||
| 1871 | 2291 | ||
| 1872 | /* True if object X, with internal type struct T *, is a pseudovector whose | ||
| 1873 | code is CODE. */ | ||
| 1874 | #define TYPED_PSEUDOVECTORP(x, t, code) \ | ||
| 1875 | (VECTORLIKEP (x) \ | ||
| 1876 | && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) | ||
| 1877 | 2292 | ||
| 1878 | /* Test for specific pseudovector types. */ | 2293 | /* Test for specific pseudovector types. */ |
| 1879 | #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) | ||
| 1880 | #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) | ||
| 1881 | #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) | ||
| 1882 | #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) | ||
| 1883 | #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) | ||
| 1884 | #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) | ||
| 1885 | #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) | ||
| 1886 | #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) | ||
| 1887 | #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) | ||
| 1888 | #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) | ||
| 1889 | #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) | ||
| 1890 | 2294 | ||
| 1891 | /* Test for image (image . spec) */ | 2295 | LISP_INLINE bool |
| 1892 | #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) | 2296 | WINDOW_CONFIGURATIONP (Lisp_Object a) |
| 1893 | 2297 | { | |
| 1894 | /* Array types. */ | 2298 | return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); |
| 1895 | 2299 | } | |
| 1896 | #define ARRAYP(x) \ | ||
| 1897 | (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) | ||
| 1898 | |||
| 1899 | #define CHECK_LIST(x) \ | ||
| 1900 | CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) | ||
| 1901 | |||
| 1902 | #define CHECK_LIST_CONS(x, y) \ | ||
| 1903 | CHECK_TYPE (CONSP (x), Qlistp, y) | ||
| 1904 | |||
| 1905 | #define CHECK_LIST_END(x, y) \ | ||
| 1906 | CHECK_TYPE (NILP (x), Qlistp, y) | ||
| 1907 | |||
| 1908 | #define CHECK_STRING(x) \ | ||
| 1909 | CHECK_TYPE (STRINGP (x), Qstringp, x) | ||
| 1910 | |||
| 1911 | #define CHECK_STRING_CAR(x) \ | ||
| 1912 | CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) | ||
| 1913 | 2300 | ||
| 1914 | #define CHECK_CONS(x) \ | 2301 | LISP_INLINE bool |
| 1915 | CHECK_TYPE (CONSP (x), Qconsp, x) | 2302 | PROCESSP (Lisp_Object a) |
| 2303 | { | ||
| 2304 | return PSEUDOVECTORP (a, PVEC_PROCESS); | ||
| 2305 | } | ||
| 1916 | 2306 | ||
| 1917 | #define CHECK_SYMBOL(x) \ | 2307 | LISP_INLINE bool |
| 1918 | CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) | 2308 | WINDOWP (Lisp_Object a) |
| 2309 | { | ||
| 2310 | return PSEUDOVECTORP (a, PVEC_WINDOW); | ||
| 2311 | } | ||
| 1919 | 2312 | ||
| 1920 | #define CHECK_CHAR_TABLE(x) \ | 2313 | LISP_INLINE bool |
| 1921 | CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) | 2314 | TERMINALP (Lisp_Object a) |
| 2315 | { | ||
| 2316 | return PSEUDOVECTORP (a, PVEC_TERMINAL); | ||
| 2317 | } | ||
| 1922 | 2318 | ||
| 1923 | #define CHECK_VECTOR(x) \ | 2319 | LISP_INLINE bool |
| 1924 | CHECK_TYPE (VECTORP (x), Qvectorp, x) | 2320 | SUBRP (Lisp_Object a) |
| 2321 | { | ||
| 2322 | return PSEUDOVECTORP (a, PVEC_SUBR); | ||
| 2323 | } | ||
| 1925 | 2324 | ||
| 1926 | #define CHECK_VECTOR_OR_STRING(x) \ | 2325 | LISP_INLINE bool |
| 1927 | CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) | 2326 | COMPILEDP (Lisp_Object a) |
| 2327 | { | ||
| 2328 | return PSEUDOVECTORP (a, PVEC_COMPILED); | ||
| 2329 | } | ||
| 1928 | 2330 | ||
| 1929 | #define CHECK_ARRAY(x, Qxxxp) \ | 2331 | LISP_INLINE bool |
| 1930 | CHECK_TYPE (ARRAYP (x), Qxxxp, x) | 2332 | BUFFERP (Lisp_Object a) |
| 2333 | { | ||
| 2334 | return PSEUDOVECTORP (a, PVEC_BUFFER); | ||
| 2335 | } | ||
| 1931 | 2336 | ||
| 1932 | #define CHECK_VECTOR_OR_CHAR_TABLE(x) \ | 2337 | LISP_INLINE bool |
| 1933 | CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) | 2338 | CHAR_TABLE_P (Lisp_Object a) |
| 2339 | { | ||
| 2340 | return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); | ||
| 2341 | } | ||
| 1934 | 2342 | ||
| 1935 | #define CHECK_BUFFER(x) \ | 2343 | LISP_INLINE bool |
| 1936 | CHECK_TYPE (BUFFERP (x), Qbufferp, x) | 2344 | SUB_CHAR_TABLE_P (Lisp_Object a) |
| 2345 | { | ||
| 2346 | return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); | ||
| 2347 | } | ||
| 1937 | 2348 | ||
| 1938 | #define CHECK_WINDOW(x) \ | 2349 | LISP_INLINE bool |
| 1939 | CHECK_TYPE (WINDOWP (x), Qwindowp, x) | 2350 | BOOL_VECTOR_P (Lisp_Object a) |
| 2351 | { | ||
| 2352 | return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); | ||
| 2353 | } | ||
| 1940 | 2354 | ||
| 1941 | #define CHECK_WINDOW_CONFIGURATION(x) \ | 2355 | LISP_INLINE bool |
| 1942 | CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) | 2356 | FRAMEP (Lisp_Object a) |
| 2357 | { | ||
| 2358 | return PSEUDOVECTORP (a, PVEC_FRAME); | ||
| 2359 | } | ||
| 1943 | 2360 | ||
| 1944 | #define CHECK_PROCESS(x) \ | 2361 | /* Test for image (image . spec) */ |
| 1945 | CHECK_TYPE (PROCESSP (x), Qprocessp, x) | 2362 | LISP_INLINE bool |
| 2363 | IMAGEP (Lisp_Object x) | ||
| 2364 | { | ||
| 2365 | return CONSP (x) && EQ (XCAR (x), Qimage); | ||
| 2366 | } | ||
| 1946 | 2367 | ||
| 1947 | #define CHECK_SUBR(x) \ | 2368 | /* Array types. */ |
| 1948 | CHECK_TYPE (SUBRP (x), Qsubrp, x) | 2369 | LISP_INLINE bool |
| 2370 | ARRAYP (Lisp_Object x) | ||
| 2371 | { | ||
| 2372 | return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); | ||
| 2373 | } | ||
| 2374 | |||
| 2375 | LISP_INLINE void | ||
| 2376 | CHECK_LIST (Lisp_Object x) | ||
| 2377 | { | ||
| 2378 | CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); | ||
| 2379 | } | ||
| 1949 | 2380 | ||
| 1950 | #define CHECK_NUMBER(x) \ | 2381 | LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y)) |
| 1951 | CHECK_TYPE (INTEGERP (x), Qintegerp, x) | 2382 | LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x)) |
| 2383 | LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x)) | ||
| 1952 | 2384 | ||
| 1953 | #define CHECK_NATNUM(x) \ | 2385 | LISP_INLINE void |
| 1954 | CHECK_TYPE (NATNUMP (x), Qwholenump, x) | 2386 | CHECK_STRING (Lisp_Object x) |
| 2387 | { | ||
| 2388 | CHECK_TYPE (STRINGP (x), Qstringp, x); | ||
| 2389 | } | ||
| 2390 | LISP_INLINE void | ||
| 2391 | CHECK_STRING_CAR (Lisp_Object x) | ||
| 2392 | { | ||
| 2393 | CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); | ||
| 2394 | } | ||
| 2395 | LISP_INLINE void | ||
| 2396 | CHECK_CONS (Lisp_Object x) | ||
| 2397 | { | ||
| 2398 | CHECK_TYPE (CONSP (x), Qconsp, x); | ||
| 2399 | } | ||
| 2400 | LISP_INLINE void | ||
| 2401 | CHECK_VECTOR (Lisp_Object x) | ||
| 2402 | { | ||
| 2403 | CHECK_TYPE (VECTORP (x), Qvectorp, x); | ||
| 2404 | } | ||
| 2405 | LISP_INLINE void | ||
| 2406 | CHECK_VECTOR_OR_STRING (Lisp_Object x) | ||
| 2407 | { | ||
| 2408 | CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); | ||
| 2409 | } | ||
| 2410 | LISP_INLINE void | ||
| 2411 | CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) | ||
| 2412 | { | ||
| 2413 | CHECK_TYPE (ARRAYP (x), Qxxxp, x); | ||
| 2414 | } | ||
| 2415 | LISP_INLINE void | ||
| 2416 | CHECK_BUFFER (Lisp_Object x) | ||
| 2417 | { | ||
| 2418 | CHECK_TYPE (BUFFERP (x), Qbufferp, x); | ||
| 2419 | } | ||
| 2420 | LISP_INLINE void | ||
| 2421 | CHECK_WINDOW (Lisp_Object x) | ||
| 2422 | { | ||
| 2423 | CHECK_TYPE (WINDOWP (x), Qwindowp, x); | ||
| 2424 | } | ||
| 2425 | LISP_INLINE void | ||
| 2426 | CHECK_PROCESS (Lisp_Object x) | ||
| 2427 | { | ||
| 2428 | CHECK_TYPE (PROCESSP (x), Qprocessp, x); | ||
| 2429 | } | ||
| 2430 | LISP_INLINE void | ||
| 2431 | CHECK_NATNUM (Lisp_Object x) | ||
| 2432 | { | ||
| 2433 | CHECK_TYPE (NATNUMP (x), Qwholenump, x); | ||
| 2434 | } | ||
| 1955 | 2435 | ||
| 1956 | #define CHECK_RANGED_INTEGER(x, lo, hi) \ | 2436 | #define CHECK_RANGED_INTEGER(x, lo, hi) \ |
| 1957 | do { \ | 2437 | do { \ |
| @@ -1972,57 +2452,43 @@ XSAVE_OBJECT (Lisp_Object obj, int n) | |||
| 1972 | CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ | 2452 | CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ |
| 1973 | } while (0) | 2453 | } while (0) |
| 1974 | 2454 | ||
| 1975 | #define CHECK_MARKER(x) \ | ||
| 1976 | CHECK_TYPE (MARKERP (x), Qmarkerp, x) | ||
| 1977 | |||
| 1978 | #define CHECK_NUMBER_COERCE_MARKER(x) \ | 2455 | #define CHECK_NUMBER_COERCE_MARKER(x) \ |
| 1979 | do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ | 2456 | do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ |
| 1980 | else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) | 2457 | else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) |
| 1981 | 2458 | ||
| 1982 | #define XFLOATINT(n) extract_float((n)) | 2459 | LISP_INLINE double |
| 1983 | 2460 | XFLOATINT (Lisp_Object n) | |
| 1984 | #define CHECK_FLOAT(x) \ | 2461 | { |
| 1985 | CHECK_TYPE (FLOATP (x), Qfloatp, x) | 2462 | return extract_float (n); |
| 2463 | } | ||
| 1986 | 2464 | ||
| 1987 | #define CHECK_NUMBER_OR_FLOAT(x) \ | 2465 | LISP_INLINE void |
| 1988 | CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) | 2466 | CHECK_NUMBER_OR_FLOAT (Lisp_Object x) |
| 2467 | { | ||
| 2468 | CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x); | ||
| 2469 | } | ||
| 1989 | 2470 | ||
| 1990 | #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ | 2471 | #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ |
| 1991 | do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ | 2472 | do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ |
| 1992 | else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) | 2473 | else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) |
| 1993 | 2474 | ||
| 1994 | #define CHECK_OVERLAY(x) \ | ||
| 1995 | CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) | ||
| 1996 | |||
| 1997 | /* Since we can't assign directly to the CAR or CDR fields of a cons | 2475 | /* Since we can't assign directly to the CAR or CDR fields of a cons |
| 1998 | cell, use these when checking that those fields contain numbers. */ | 2476 | cell, use these when checking that those fields contain numbers. */ |
| 1999 | #define CHECK_NUMBER_CAR(x) \ | 2477 | LISP_INLINE void |
| 2000 | do { \ | 2478 | CHECK_NUMBER_CAR (Lisp_Object x) |
| 2001 | Lisp_Object tmp = XCAR (x); \ | 2479 | { |
| 2002 | CHECK_NUMBER (tmp); \ | 2480 | Lisp_Object tmp = XCAR (x); |
| 2003 | XSETCAR ((x), tmp); \ | 2481 | CHECK_NUMBER (tmp); |
| 2004 | } while (0) | 2482 | XSETCAR (x, tmp); |
| 2005 | 2483 | } | |
| 2006 | #define CHECK_NUMBER_CDR(x) \ | ||
| 2007 | do { \ | ||
| 2008 | Lisp_Object tmp = XCDR (x); \ | ||
| 2009 | CHECK_NUMBER (tmp); \ | ||
| 2010 | XSETCDR ((x), tmp); \ | ||
| 2011 | } while (0) | ||
| 2012 | |||
| 2013 | #define CHECK_NATNUM_CAR(x) \ | ||
| 2014 | do { \ | ||
| 2015 | Lisp_Object tmp = XCAR (x); \ | ||
| 2016 | CHECK_NATNUM (tmp); \ | ||
| 2017 | XSETCAR ((x), tmp); \ | ||
| 2018 | } while (0) | ||
| 2019 | 2484 | ||
| 2020 | #define CHECK_NATNUM_CDR(x) \ | 2485 | LISP_INLINE void |
| 2021 | do { \ | 2486 | CHECK_NUMBER_CDR (Lisp_Object x) |
| 2022 | Lisp_Object tmp = XCDR (x); \ | 2487 | { |
| 2023 | CHECK_NATNUM (tmp); \ | 2488 | Lisp_Object tmp = XCDR (x); |
| 2024 | XSETCDR ((x), tmp); \ | 2489 | CHECK_NUMBER (tmp); |
| 2025 | } while (0) | 2490 | XSETCDR (x, tmp); |
| 2491 | } | ||
| 2026 | 2492 | ||
| 2027 | /* Define a built-in function for calling from Lisp. | 2493 | /* Define a built-in function for calling from Lisp. |
| 2028 | `lname' should be the name to give the function in Lisp, | 2494 | `lname' should be the name to give the function in Lisp, |
| @@ -2088,8 +2554,12 @@ XSAVE_OBJECT (Lisp_Object obj, int n) | |||
| 2088 | #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | 2554 | #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ |
| 2089 | Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) | 2555 | Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) |
| 2090 | 2556 | ||
| 2091 | /* Non-zero if OBJ is a Lisp function. */ | 2557 | /* True if OBJ is a Lisp function. */ |
| 2092 | #define FUNCTIONP(OBJ) functionp(OBJ) | 2558 | LISP_INLINE bool |
| 2559 | FUNCTIONP (Lisp_Object obj) | ||
| 2560 | { | ||
| 2561 | return functionp (obj); | ||
| 2562 | } | ||
| 2093 | 2563 | ||
| 2094 | /* defsubr (Sname); | 2564 | /* defsubr (Sname); |
| 2095 | is how we define the symbol for function `name' at start-up time. */ | 2565 | is how we define the symbol for function `name' at start-up time. */ |
| @@ -2245,38 +2715,15 @@ struct specbinding | |||
| 2245 | } v; | 2715 | } v; |
| 2246 | }; | 2716 | }; |
| 2247 | 2717 | ||
| 2248 | LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) | ||
| 2249 | { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } | ||
| 2250 | |||
| 2251 | LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl) | ||
| 2252 | { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; } | ||
| 2253 | |||
| 2254 | LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl) | ||
| 2255 | { eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; } | ||
| 2256 | |||
| 2257 | LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl) | ||
| 2258 | { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; } | ||
| 2259 | |||
| 2260 | LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl) | ||
| 2261 | { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; } | ||
| 2262 | |||
| 2263 | LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl) | ||
| 2264 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; } | ||
| 2265 | |||
| 2266 | LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl) | ||
| 2267 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; } | ||
| 2268 | |||
| 2269 | LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl) | ||
| 2270 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; } | ||
| 2271 | |||
| 2272 | LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl) | ||
| 2273 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; } | ||
| 2274 | |||
| 2275 | extern struct specbinding *specpdl; | 2718 | extern struct specbinding *specpdl; |
| 2276 | extern struct specbinding *specpdl_ptr; | 2719 | extern struct specbinding *specpdl_ptr; |
| 2277 | extern ptrdiff_t specpdl_size; | 2720 | extern ptrdiff_t specpdl_size; |
| 2278 | 2721 | ||
| 2279 | #define SPECPDL_INDEX() (specpdl_ptr - specpdl) | 2722 | LISP_INLINE ptrdiff_t |
| 2723 | SPECPDL_INDEX (void) | ||
| 2724 | { | ||
| 2725 | return specpdl_ptr - specpdl; | ||
| 2726 | } | ||
| 2280 | 2727 | ||
| 2281 | /* Everything needed to describe an active condition case. | 2728 | /* Everything needed to describe an active condition case. |
| 2282 | 2729 | ||
| @@ -2592,27 +3039,12 @@ void staticpro (Lisp_Object *); | |||
| 2592 | #define EXFUN(fnname, maxargs) \ | 3039 | #define EXFUN(fnname, maxargs) \ |
| 2593 | extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs | 3040 | extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs |
| 2594 | 3041 | ||
| 3042 | #include "globals.h" | ||
| 3043 | |||
| 2595 | /* Forward declarations for prototypes. */ | 3044 | /* Forward declarations for prototypes. */ |
| 2596 | struct window; | 3045 | struct window; |
| 2597 | struct frame; | 3046 | struct frame; |
| 2598 | 3047 | ||
| 2599 | /* Simple access functions. */ | ||
| 2600 | |||
| 2601 | LISP_INLINE Lisp_Object * | ||
| 2602 | aref_addr (Lisp_Object array, ptrdiff_t idx) | ||
| 2603 | { | ||
| 2604 | return & XVECTOR (array)->contents[idx]; | ||
| 2605 | } | ||
| 2606 | |||
| 2607 | LISP_INLINE void | ||
| 2608 | gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) | ||
| 2609 | { | ||
| 2610 | /* Like ASET, but also can be used in the garbage collector: | ||
| 2611 | sweep_weak_table calls set_hash_key etc. while the table is marked. */ | ||
| 2612 | eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); | ||
| 2613 | XVECTOR (array)->contents[idx] = val; | ||
| 2614 | } | ||
| 2615 | |||
| 2616 | /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ | 3048 | /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ |
| 2617 | 3049 | ||
| 2618 | LISP_INLINE void | 3050 | LISP_INLINE void |
| @@ -2625,12 +3057,6 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count) | |||
| 2625 | /* Functions to modify hash tables. */ | 3057 | /* Functions to modify hash tables. */ |
| 2626 | 3058 | ||
| 2627 | LISP_INLINE void | 3059 | LISP_INLINE void |
| 2628 | set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value) | ||
| 2629 | { | ||
| 2630 | h->key_and_value = key_and_value; | ||
| 2631 | } | ||
| 2632 | |||
| 2633 | LISP_INLINE void | ||
| 2634 | set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | 3060 | set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) |
| 2635 | { | 3061 | { |
| 2636 | gc_aset (h->key_and_value, 2 * idx, val); | 3062 | gc_aset (h->key_and_value, 2 * idx, val); |
| @@ -2642,52 +3068,10 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | |||
| 2642 | gc_aset (h->key_and_value, 2 * idx + 1, val); | 3068 | gc_aset (h->key_and_value, 2 * idx + 1, val); |
| 2643 | } | 3069 | } |
| 2644 | 3070 | ||
| 2645 | LISP_INLINE void | ||
| 2646 | set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) | ||
| 2647 | { | ||
| 2648 | h->next = next; | ||
| 2649 | } | ||
| 2650 | |||
| 2651 | LISP_INLINE void | ||
| 2652 | set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 2653 | { | ||
| 2654 | gc_aset (h->next, idx, val); | ||
| 2655 | } | ||
| 2656 | |||
| 2657 | LISP_INLINE void | ||
| 2658 | set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) | ||
| 2659 | { | ||
| 2660 | h->hash = hash; | ||
| 2661 | } | ||
| 2662 | |||
| 2663 | LISP_INLINE void | ||
| 2664 | set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 2665 | { | ||
| 2666 | gc_aset (h->hash, idx, val); | ||
| 2667 | } | ||
| 2668 | |||
| 2669 | LISP_INLINE void | ||
| 2670 | set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) | ||
| 2671 | { | ||
| 2672 | h->index = index; | ||
| 2673 | } | ||
| 2674 | |||
| 2675 | LISP_INLINE void | ||
| 2676 | set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) | ||
| 2677 | { | ||
| 2678 | gc_aset (h->index, idx, val); | ||
| 2679 | } | ||
| 2680 | |||
| 2681 | /* Use these functions to set Lisp_Object | 3071 | /* Use these functions to set Lisp_Object |
| 2682 | or pointer slots of struct Lisp_Symbol. */ | 3072 | or pointer slots of struct Lisp_Symbol. */ |
| 2683 | 3073 | ||
| 2684 | LISP_INLINE void | 3074 | LISP_INLINE void |
| 2685 | set_symbol_name (Lisp_Object sym, Lisp_Object name) | ||
| 2686 | { | ||
| 2687 | XSYMBOL (sym)->name = name; | ||
| 2688 | } | ||
| 2689 | |||
| 2690 | LISP_INLINE void | ||
| 2691 | set_symbol_function (Lisp_Object sym, Lisp_Object function) | 3075 | set_symbol_function (Lisp_Object sym, Lisp_Object function) |
| 2692 | { | 3076 | { |
| 2693 | XSYMBOL (sym)->function = function; | 3077 | XSYMBOL (sym)->function = function; |
| @@ -2714,43 +3098,6 @@ blv_found (struct Lisp_Buffer_Local_Value *blv) | |||
| 2714 | return blv->found; | 3098 | return blv->found; |
| 2715 | } | 3099 | } |
| 2716 | 3100 | ||
| 2717 | LISP_INLINE void | ||
| 2718 | set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) | ||
| 2719 | { | ||
| 2720 | eassert (found == !EQ (blv->defcell, blv->valcell)); | ||
| 2721 | blv->found = found; | ||
| 2722 | } | ||
| 2723 | |||
| 2724 | LISP_INLINE Lisp_Object | ||
| 2725 | blv_value (struct Lisp_Buffer_Local_Value *blv) | ||
| 2726 | { | ||
| 2727 | return XCDR (blv->valcell); | ||
| 2728 | } | ||
| 2729 | |||
| 2730 | LISP_INLINE void | ||
| 2731 | set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 2732 | { | ||
| 2733 | XSETCDR (blv->valcell, val); | ||
| 2734 | } | ||
| 2735 | |||
| 2736 | LISP_INLINE void | ||
| 2737 | set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 2738 | { | ||
| 2739 | blv->where = val; | ||
| 2740 | } | ||
| 2741 | |||
| 2742 | LISP_INLINE void | ||
| 2743 | set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 2744 | { | ||
| 2745 | blv->defcell = val; | ||
| 2746 | } | ||
| 2747 | |||
| 2748 | LISP_INLINE void | ||
| 2749 | set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val) | ||
| 2750 | { | ||
| 2751 | blv->valcell = val; | ||
| 2752 | } | ||
| 2753 | |||
| 2754 | /* Set overlay's property list. */ | 3101 | /* Set overlay's property list. */ |
| 2755 | 3102 | ||
| 2756 | LISP_INLINE void | 3103 | LISP_INLINE void |
| @@ -2779,21 +3126,11 @@ set_string_intervals (Lisp_Object s, INTERVAL i) | |||
| 2779 | of setting slots directly. */ | 3126 | of setting slots directly. */ |
| 2780 | 3127 | ||
| 2781 | LISP_INLINE void | 3128 | LISP_INLINE void |
| 2782 | set_char_table_ascii (Lisp_Object table, Lisp_Object val) | ||
| 2783 | { | ||
| 2784 | XCHAR_TABLE (table)->ascii = val; | ||
| 2785 | } | ||
| 2786 | LISP_INLINE void | ||
| 2787 | set_char_table_defalt (Lisp_Object table, Lisp_Object val) | 3129 | set_char_table_defalt (Lisp_Object table, Lisp_Object val) |
| 2788 | { | 3130 | { |
| 2789 | XCHAR_TABLE (table)->defalt = val; | 3131 | XCHAR_TABLE (table)->defalt = val; |
| 2790 | } | 3132 | } |
| 2791 | LISP_INLINE void | 3133 | LISP_INLINE void |
| 2792 | set_char_table_parent (Lisp_Object table, Lisp_Object val) | ||
| 2793 | { | ||
| 2794 | XCHAR_TABLE (table)->parent = val; | ||
| 2795 | } | ||
| 2796 | LISP_INLINE void | ||
| 2797 | set_char_table_purpose (Lisp_Object table, Lisp_Object val) | 3134 | set_char_table_purpose (Lisp_Object table, Lisp_Object val) |
| 2798 | { | 3135 | { |
| 2799 | XCHAR_TABLE (table)->purpose = val; | 3136 | XCHAR_TABLE (table)->purpose = val; |
| @@ -3237,7 +3574,7 @@ extern int valid_lisp_object_p (Lisp_Object); | |||
| 3237 | #ifdef GC_CHECK_CONS_LIST | 3574 | #ifdef GC_CHECK_CONS_LIST |
| 3238 | extern void check_cons_list (void); | 3575 | extern void check_cons_list (void); |
| 3239 | #else | 3576 | #else |
| 3240 | #define check_cons_list() ((void) 0) | 3577 | LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } |
| 3241 | #endif | 3578 | #endif |
| 3242 | 3579 | ||
| 3243 | #ifdef REL_ALLOC | 3580 | #ifdef REL_ALLOC |
| @@ -3305,10 +3642,12 @@ extern Lisp_Object check_obarray (Lisp_Object); | |||
| 3305 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); | 3642 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); |
| 3306 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); | 3643 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); |
| 3307 | extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); | 3644 | extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); |
| 3308 | #define LOADHIST_ATTACH(x) \ | 3645 | LISP_INLINE void |
| 3309 | do { \ | 3646 | LOADHIST_ATTACH (Lisp_Object x) |
| 3310 | if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ | 3647 | { |
| 3311 | } while (0) | 3648 | if (initialized) |
| 3649 | Vcurrent_load_list = Fcons (x, Vcurrent_load_list); | ||
| 3650 | } | ||
| 3312 | extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, | 3651 | extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, |
| 3313 | Lisp_Object *, Lisp_Object); | 3652 | Lisp_Object *, Lisp_Object); |
| 3314 | extern Lisp_Object string_to_number (char const *, int, bool); | 3653 | extern Lisp_Object string_to_number (char const *, int, bool); |
| @@ -3594,10 +3933,9 @@ void fixup_locale (void); | |||
| 3594 | void synchronize_system_messages_locale (void); | 3933 | void synchronize_system_messages_locale (void); |
| 3595 | void synchronize_system_time_locale (void); | 3934 | void synchronize_system_time_locale (void); |
| 3596 | #else | 3935 | #else |
| 3597 | #define setlocale(category, locale) | 3936 | LISP_INLINE void fixup_locale (void) {} |
| 3598 | #define fixup_locale() | 3937 | LISP_INLINE void synchronize_system_messages_locale (void) {} |
| 3599 | #define synchronize_system_messages_locale() | 3938 | LISP_INLINE void synchronize_system_time_locale (void) {} |
| 3600 | #define synchronize_system_time_locale() | ||
| 3601 | #endif | 3939 | #endif |
| 3602 | extern void shut_down_emacs (int, Lisp_Object); | 3940 | extern void shut_down_emacs (int, Lisp_Object); |
| 3603 | 3941 | ||
| @@ -3956,8 +4294,6 @@ extern void *record_xmalloc (size_t); | |||
| 3956 | } while (0) | 4294 | } while (0) |
| 3957 | 4295 | ||
| 3958 | 4296 | ||
| 3959 | #include "globals.h" | ||
| 3960 | |||
| 3961 | /* Check whether it's time for GC, and run it if so. */ | 4297 | /* Check whether it's time for GC, and run it if so. */ |
| 3962 | 4298 | ||
| 3963 | LISP_INLINE void | 4299 | LISP_INLINE void |
| @@ -3970,7 +4306,7 @@ maybe_gc (void) | |||
| 3970 | Fgarbage_collect (); | 4306 | Fgarbage_collect (); |
| 3971 | } | 4307 | } |
| 3972 | 4308 | ||
| 3973 | LISP_INLINE int | 4309 | LISP_INLINE bool |
| 3974 | functionp (Lisp_Object object) | 4310 | functionp (Lisp_Object object) |
| 3975 | { | 4311 | { |
| 3976 | if (SYMBOLP (object) && !NILP (Ffboundp (object))) | 4312 | if (SYMBOLP (object) && !NILP (Ffboundp (object))) |
diff --git a/src/marker.c b/src/marker.c index 63027d3be5e..6c50def51a3 100644 --- a/src/marker.c +++ b/src/marker.c | |||
| @@ -127,6 +127,12 @@ clear_charpos_cache (struct buffer *b) | |||
| 127 | } \ | 127 | } \ |
| 128 | } | 128 | } |
| 129 | 129 | ||
| 130 | static void | ||
| 131 | CHECK_MARKER (Lisp_Object x) | ||
| 132 | { | ||
| 133 | CHECK_TYPE (MARKERP (x), Qmarkerp, x); | ||
| 134 | } | ||
| 135 | |||
| 130 | /* Return the byte position corresponding to CHARPOS in B. */ | 136 | /* Return the byte position corresponding to CHARPOS in B. */ |
| 131 | 137 | ||
| 132 | ptrdiff_t | 138 | ptrdiff_t |
diff --git a/src/textprop.c b/src/textprop.c index cc364d5a38c..03b8de120cd 100644 --- a/src/textprop.c +++ b/src/textprop.c | |||
| @@ -98,6 +98,14 @@ modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) | |||
| 98 | set_buffer_internal (old); | 98 | set_buffer_internal (old); |
| 99 | } | 99 | } |
| 100 | 100 | ||
| 101 | /* Complain if object is not string or buffer type. */ | ||
| 102 | |||
| 103 | static void | ||
| 104 | CHECK_STRING_OR_BUFFER (Lisp_Object x) | ||
| 105 | { | ||
| 106 | CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); | ||
| 107 | } | ||
| 108 | |||
| 101 | /* Extract the interval at the position pointed to by BEGIN from | 109 | /* Extract the interval at the position pointed to by BEGIN from |
| 102 | OBJECT, a string or buffer. Additionally, check that the positions | 110 | OBJECT, a string or buffer. Additionally, check that the positions |
| 103 | pointed to by BEGIN and END are within the bounds of OBJECT, and | 111 | pointed to by BEGIN and END are within the bounds of OBJECT, and |
diff --git a/src/window.c b/src/window.c index 28e01103eb1..76432f8bb6b 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -55,7 +55,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 55 | 55 | ||
| 56 | Lisp_Object Qwindowp, Qwindow_live_p; | 56 | Lisp_Object Qwindowp, Qwindow_live_p; |
| 57 | static Lisp_Object Qwindow_valid_p; | 57 | static Lisp_Object Qwindow_valid_p; |
| 58 | static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; | 58 | static Lisp_Object Qwindow_configuration_p; |
| 59 | static Lisp_Object Qrecord_window_buffer; | ||
| 59 | static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; | 60 | static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; |
| 60 | static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; | 61 | static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; |
| 61 | static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; | 62 | static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; |
| @@ -130,6 +131,12 @@ static int window_scroll_pixel_based_preserve_y; | |||
| 130 | static EMACS_INT window_scroll_preserve_hpos; | 131 | static EMACS_INT window_scroll_preserve_hpos; |
| 131 | static EMACS_INT window_scroll_preserve_vpos; | 132 | static EMACS_INT window_scroll_preserve_vpos; |
| 132 | 133 | ||
| 134 | static void | ||
| 135 | CHECK_WINDOW_CONFIGURATION (Lisp_Object x) | ||
| 136 | { | ||
| 137 | CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x); | ||
| 138 | } | ||
| 139 | |||
| 133 | /* These setters are used only in this file, so they can be private. */ | 140 | /* These setters are used only in this file, so they can be private. */ |
| 134 | static void | 141 | static void |
| 135 | wset_combination_limit (struct window *w, Lisp_Object val) | 142 | wset_combination_limit (struct window *w, Lisp_Object val) |
diff --git a/src/window.h b/src/window.h index 411756f045e..846831e43d5 100644 --- a/src/window.h +++ b/src/window.h | |||
| @@ -958,7 +958,7 @@ struct glyph *get_phys_cursor_glyph (struct window *w); | |||
| 958 | 958 | ||
| 959 | /* These used to be in lisp.h. */ | 959 | /* These used to be in lisp.h. */ |
| 960 | 960 | ||
| 961 | extern Lisp_Object Qwindowp, Qwindow_live_p; | 961 | extern Lisp_Object Qwindow_live_p; |
| 962 | extern Lisp_Object Vwindow_list; | 962 | extern Lisp_Object Vwindow_list; |
| 963 | 963 | ||
| 964 | extern struct window *decode_live_window (Lisp_Object); | 964 | extern struct window *decode_live_window (Lisp_Object); |