Use a simple struct to implement compile time checks for the Lisp_Object type
* configure.in: Rename --enable-use-lisp-union-type to --enable-check-lisp-object-type and define CHECK_LISP_OBJECT_TYPE instead of USE_LISP_UNION_TYPE. * admin/make-emacs: Rename --union-type to --check-lisp-type. Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. * admin/CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from USE_LISP_UNION_TYPE. * src/lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]: Define as struct instead of union. (XLI, XIL): Define. (XHASH, XTYPE, XINT, XUINT, make_number, XSET, XPNTR, XUNTAG): Use them. * src/emacs.c (gdb_use_struct): Renamed from gdb_use_union. * src/.gdbinit: Check gdb_use_struct instead of gdb_use_union. * src/alloc.c (widen_to_Lisp_Object): Removed. (mark_memory): Use XIL instead of widen_to_Lisp_Object. * src/frame.c (delete_frame): Remove outdated comment. * src/w32fns.c (Fw32_register_hot_key): Use XLI instead of checking USE_LISP_UNION_TYPE. (Fw32_unregister_hot_key): Likewise. (Fw32_toggle_lock_key): Likewise. * src/w32menu.c (add_menu_item): Likewise. (w32_menu_display_help): Use XIL instead of checking USE_LISP_UNION_TYPE. * src/w32heap.c (allocate_heap): Don't check USE_LISP_UNION_TYPE. (init_heap): Likewise. * src/w32term.c (w32_read_socket): Update comment.
This commit is contained in:
Andreas Schwab
parent
ef62b23df5
commit
646b5f55df
16 changed files with 124 additions and 192 deletions
|
|
@ -1,3 +1,9 @@
|
|||
2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
|
||||
|
||||
* configure.in: Rename --enable-use-lisp-union-type to
|
||||
--enable-check-lisp-object-type and define CHECK_LISP_OBJECT_TYPE
|
||||
instead of USE_LISP_UNION_TYPE.
|
||||
|
||||
2012-06-12 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* configure.in (HAVE_PROCFS, _STRUCTURED_PROC): New AC_DEFINEs.
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ HAVE_PROCFS The /proc filesystem is supported.
|
|||
REL_ALLOC Compile in the relocatable memory allocator ralloc.c.
|
||||
SYSTEM_MALLOC Use the system library's malloc.
|
||||
subprocesses System can use subprocesses (for M-x shell for example). Defined by default, only MSDOS undefines it.
|
||||
USE_LISP_UNION_TYPE Define it in lisp.h to make Lisp_Object be a union type instead of the default int.
|
||||
DEBUG_LISP_OBJECT_TYPE Define it in lisp.h enable compile time checks on Lisp_Object use.
|
||||
|
||||
** System specific macros, described in detail in src/s/template.h
|
||||
CLASH_DETECTION
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
|
||||
|
||||
* make-emacs: Rename --union-type to --check-lisp-type. Define
|
||||
CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
|
||||
* CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from
|
||||
USE_LISP_UNION_TYPE.
|
||||
|
||||
2012-06-03 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* quick-install-emacs (PUBLIC_LIBSRC_SCRIPTS): Remove rcs-checkin.
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
"check-marked" => \$check_marked,
|
||||
"all" => \$all,
|
||||
"no-optim" => \$no_optim,
|
||||
"union-type" => \$union_type,
|
||||
"check-lisp-type" => \$check_lisp_type,
|
||||
"gprof" => \$profile,
|
||||
"malloc-check" => \$malloc_check,
|
||||
"no-mcheck" => \$no_mcheck,
|
||||
|
|
@ -70,7 +70,7 @@
|
|||
--check-marked GC_CHECK_MARKED_OBJECTS=1
|
||||
--optim no debug defines
|
||||
--gprof make Emacs for profiling
|
||||
--union-type define USE_LISP_UNION_TYPE (bad for GDB)
|
||||
--check-lisp-type define CHECK_LISP_OBJECT_TYPE
|
||||
--malloc-check define GC_MALLOC_CHECK
|
||||
--no-mcheck don't define GC_MCHECK
|
||||
--wall compile with -Wall
|
||||
|
|
@ -140,7 +140,7 @@
|
|||
}
|
||||
}
|
||||
|
||||
$defs = "$defs -DUSE_LISP_UNION_TYPE" if $union_type;
|
||||
$defs = "$defs -DCHECK_LISP_OBJECT_TYPE" if $check_lisp_type;
|
||||
$defs = "$defs -DGC_MALLOC_CHECK=1 -DGC_PROTECT_MALLOC_STATE=1" if $malloc_check;
|
||||
$defs = "$defs -DGC_MCHECK=1" unless $no_mcheck;
|
||||
|
||||
|
|
|
|||
12
configure.in
12
configure.in
|
|
@ -309,13 +309,13 @@ if test x$ac_gc_check_cons_list != x ; then
|
|||
[Define this to check for errors in cons list.])
|
||||
fi
|
||||
|
||||
AC_ARG_ENABLE(use-lisp-union-type,
|
||||
[AS_HELP_STRING([--enable-use-lisp-union-type],
|
||||
[use a union for the Lisp_Object data type.
|
||||
This is only useful for development for catching certain types of bugs.])],
|
||||
AC_ARG_ENABLE(check-lisp-object-type,
|
||||
[AS_HELP_STRING([--enable-check-lisp-object-type],
|
||||
[enable compile time checks for the Lisp_Object data type.
|
||||
This is useful for development for catching certain types of bugs.])],
|
||||
if test "${enableval}" != "no"; then
|
||||
AC_DEFINE(USE_LISP_UNION_TYPE, 1,
|
||||
[Define this to use a lisp union for the Lisp_Object data type.])
|
||||
AC_DEFINE(CHECK_LISP_OBJECT_TYPE, 1,
|
||||
[Define this to enable compile time checks for the Lisp_Object data type.])
|
||||
fi)
|
||||
|
||||
|
||||
|
|
|
|||
5
etc/NEWS
5
etc/NEWS
|
|
@ -49,6 +49,11 @@ directories to the search path. You must add them yourself if you want them.
|
|||
(from the bin and libexec directories, respectively). The former is
|
||||
no longer relevant, the latter is replaced by lisp (in vc-sccs.el).
|
||||
|
||||
** The configuration option '--enable-use-lisp-union-type' has been
|
||||
renamed to '--enable-check-lisp-object-type', as the resulting
|
||||
Lisp_Object type no longer uses a union to implement the compile time
|
||||
check that this option enables.
|
||||
|
||||
|
||||
* Startup Changes in Emacs 24.2
|
||||
|
||||
|
|
|
|||
26
src/.gdbinit
26
src/.gdbinit
|
|
@ -49,17 +49,26 @@ handle SIGALRM ignore
|
|||
# Using a constant runs into GDB bugs sometimes.
|
||||
define xgetptr
|
||||
set $bugfix = $arg0
|
||||
set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
|
||||
if gdb_use_struct
|
||||
set $bugfix = $bugfix.i
|
||||
end
|
||||
set $ptr = $bugfix & $valmask | gdb_data_seg_bits
|
||||
end
|
||||
|
||||
define xgetint
|
||||
set $bugfix = $arg0
|
||||
set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix >> (gdb_gctypebits - 1) : $bugfix << gdb_gctypebits) >> gdb_gctypebits
|
||||
if gdb_use_struct
|
||||
set $bugfix = $bugfix.i
|
||||
end
|
||||
set $int = gdb_use_lsb ? $bugfix >> (gdb_gctypebits - 1) : $bugfix << gdb_gctypebits) >> gdb_gctypebits
|
||||
end
|
||||
|
||||
define xgettype
|
||||
set $bugfix = $arg0
|
||||
set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
|
||||
if gdb_use_struct
|
||||
set $bugfix = $bugfix.i
|
||||
end
|
||||
set $type = (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
|
||||
end
|
||||
|
||||
# Set up something to print out s-expressions.
|
||||
|
|
@ -949,15 +958,8 @@ end
|
|||
|
||||
define xpr
|
||||
xtype
|
||||
if gdb_use_union
|
||||
if $type == Lisp_Int
|
||||
xint
|
||||
end
|
||||
end
|
||||
if !gdb_use_union
|
||||
if $type == Lisp_Int0 || $type == Lisp_Int1
|
||||
xint
|
||||
end
|
||||
if $type == Lisp_Int0 || $type == Lisp_Int1
|
||||
xint
|
||||
end
|
||||
if $type == Lisp_Symbol
|
||||
xsymbol
|
||||
|
|
|
|||
|
|
@ -1,3 +1,26 @@
|
|||
2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
|
||||
|
||||
* lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]: Define as struct
|
||||
instead of union.
|
||||
(XLI, XIL): Define.
|
||||
(XHASH, XTYPE, XINT, XUINT, make_number, XSET, XPNTR, XUNTAG): Use
|
||||
them.
|
||||
* emacs.c (gdb_use_struct): Renamed from gdb_use_union.
|
||||
* .gdbinit: Check gdb_use_struct instead of gdb_use_union.
|
||||
* alloc.c (widen_to_Lisp_Object): Removed.
|
||||
(mark_memory): Use XIL instead of widen_to_Lisp_Object.
|
||||
* frame.c (delete_frame): Remove outdated comment.
|
||||
* w32fns.c (Fw32_register_hot_key): Use XLI instead of checking
|
||||
USE_LISP_UNION_TYPE.
|
||||
(Fw32_unregister_hot_key): Likewise.
|
||||
(Fw32_toggle_lock_key): Likewise.
|
||||
* w32menu.c (add_menu_item): Likewise.
|
||||
(w32_menu_display_help): Use XIL instead of checking
|
||||
USE_LISP_UNION_TYPE.
|
||||
* w32heap.c (allocate_heap): Don't check USE_LISP_UNION_TYPE.
|
||||
(init_heap): Likewise.
|
||||
* w32term.c (w32_read_socket): Update comment.
|
||||
|
||||
2012-06-13 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* s/usg5-4-common.h, src/s/unixware.h:
|
||||
|
|
|
|||
17
src/alloc.c
17
src/alloc.c
|
|
@ -1585,21 +1585,6 @@ mark_interval_tree (register INTERVAL tree)
|
|||
(i) = balance_intervals (i); \
|
||||
} while (0)
|
||||
|
||||
/* Convert the pointer-sized word P to EMACS_INT while preserving its
|
||||
type and ptr fields. */
|
||||
static Lisp_Object
|
||||
widen_to_Lisp_Object (void *p)
|
||||
{
|
||||
intptr_t i = (intptr_t) p;
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
Lisp_Object obj;
|
||||
obj.i = i;
|
||||
return obj;
|
||||
#else
|
||||
return i;
|
||||
#endif
|
||||
}
|
||||
|
||||
/***********************************************************************
|
||||
String Allocation
|
||||
***********************************************************************/
|
||||
|
|
@ -4678,7 +4663,7 @@ mark_memory (void *start, void *end)
|
|||
void *p = *(void **) ((char *) pp + i);
|
||||
mark_maybe_pointer (p);
|
||||
if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
|
||||
mark_maybe_object (widen_to_Lisp_Object (p));
|
||||
mark_maybe_object (XIL ((intptr_t) p));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -109,10 +109,10 @@ int gdb_use_lsb EXTERNALLY_VISIBLE = 1;
|
|||
#else
|
||||
int gdb_use_lsb EXTERNALLY_VISIBLE = 0;
|
||||
#endif
|
||||
#ifndef USE_LISP_UNION_TYPE
|
||||
int gdb_use_union EXTERNALLY_VISIBLE = 0;
|
||||
#ifndef CHECK_LISP_OBJECT_TYPE
|
||||
int gdb_use_struct EXTERNALLY_VISIBLE = 0;
|
||||
#else
|
||||
int gdb_use_union EXTERNALLY_VISIBLE = 1;
|
||||
int gdb_use_struct EXTERNALLY_VISIBLE = 1;
|
||||
#endif
|
||||
int gdb_valbits EXTERNALLY_VISIBLE = VALBITS;
|
||||
int gdb_gctypebits EXTERNALLY_VISIBLE = GCTYPEBITS;
|
||||
|
|
|
|||
|
|
@ -1152,10 +1152,6 @@ other_visible_frames (FRAME_PTR f)
|
|||
described for Fdelete_frame. */
|
||||
Lisp_Object
|
||||
delete_frame (Lisp_Object frame, Lisp_Object force)
|
||||
/* If we use `register' here, gcc-4.0.2 on amd64 using
|
||||
-DUSE_LISP_UNION_TYPE complains further down that we're getting the
|
||||
address of `force'. Go figure. */
|
||||
|
||||
{
|
||||
struct frame *f;
|
||||
struct frame *sf = SELECTED_FRAME ();
|
||||
|
|
|
|||
158
src/lisp.h
158
src/lisp.h
|
|
@ -149,14 +149,12 @@ extern int suppress_checking EXTERNALLY_VISIBLE;
|
|||
#endif
|
||||
#endif /* ENABLE_CHECKING */
|
||||
|
||||
/* Use the configure flag --enable-use-lisp-union-type to make
|
||||
Lisp_Object use a union type instead of the default int. The flag
|
||||
causes USE_LISP_UNION_TYPE to be defined. */
|
||||
/* Use the configure flag --enable-check-lisp-object-type to make
|
||||
Lisp_Object use a struct type instead of the default int. The flag
|
||||
causes CHECK_LISP_OBJECT_TYPE to be defined. */
|
||||
|
||||
/***** Select the tagging scheme. *****/
|
||||
/* There are basically two options that control the tagging scheme:
|
||||
- USE_LISP_UNION_TYPE says that Lisp_Object should be a union instead
|
||||
of an integer.
|
||||
/* The following option controls the tagging scheme:
|
||||
- USE_LSB_TAG means that we can assume the least 3 bits of pointers are
|
||||
always 0, and we can thus use them to hold tag bits, without
|
||||
restricting our addressing space.
|
||||
|
|
@ -237,11 +235,6 @@ extern int suppress_checking EXTERNALLY_VISIBLE;
|
|||
e.g -2^28..2^28-1 to -2^29..2^29-1. */
|
||||
#define USE_2_TAGS_FOR_INTS
|
||||
|
||||
/* Making it work for the union case is too much trouble. */
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
# undef USE_2_TAGS_FOR_INTS
|
||||
#endif
|
||||
|
||||
/* This is the set of Lisp data types. */
|
||||
|
||||
#if !defined USE_2_TAGS_FOR_INTS
|
||||
|
|
@ -335,29 +328,17 @@ enum Lisp_Fwd_Type
|
|||
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
|
||||
};
|
||||
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
#ifdef CHECK_LISP_OBJECT_TYPE
|
||||
|
||||
typedef
|
||||
union Lisp_Object
|
||||
{
|
||||
/* Used for comparing two Lisp_Objects;
|
||||
also, positive integers can be accessed fast this way. */
|
||||
EMACS_INT i;
|
||||
typedef struct { EMACS_INT i; } Lisp_Object;
|
||||
|
||||
struct
|
||||
{
|
||||
/* Use explicit signed, the signedness of a bit-field of type
|
||||
int is implementation defined. */
|
||||
signed EMACS_INT val : VALBITS;
|
||||
ENUM_BF (Lisp_Type) type : GCTYPEBITS;
|
||||
} s;
|
||||
struct
|
||||
{
|
||||
EMACS_UINT val : VALBITS;
|
||||
ENUM_BF (Lisp_Type) type : GCTYPEBITS;
|
||||
} u;
|
||||
}
|
||||
Lisp_Object;
|
||||
#define XLI(o) (o).i
|
||||
static inline Lisp_Object
|
||||
XIL (EMACS_INT i)
|
||||
{
|
||||
Lisp_Object o = { i };
|
||||
return o;
|
||||
}
|
||||
|
||||
static inline Lisp_Object
|
||||
LISP_MAKE_RVALUE (Lisp_Object o)
|
||||
|
|
@ -367,14 +348,16 @@ LISP_MAKE_RVALUE (Lisp_Object o)
|
|||
|
||||
#define LISP_INITIALLY_ZERO {0}
|
||||
|
||||
#else /* USE_LISP_UNION_TYPE */
|
||||
#else /* CHECK_LISP_OBJECT_TYPE */
|
||||
|
||||
/* If union type is not wanted, define Lisp_Object as just a number. */
|
||||
/* If a struct type is not wanted, define Lisp_Object as just a number. */
|
||||
|
||||
typedef EMACS_INT Lisp_Object;
|
||||
#define XLI(o) (o)
|
||||
#define XIL(i) (i)
|
||||
#define LISP_MAKE_RVALUE(o) (0+(o))
|
||||
#define LISP_INITIALLY_ZERO 0
|
||||
#endif /* USE_LISP_UNION_TYPE */
|
||||
#endif /* CHECK_LISP_OBJECT_TYPE */
|
||||
|
||||
/* In the size word of a vector, this bit means the vector has been marked. */
|
||||
|
||||
|
|
@ -432,30 +415,28 @@ enum pvec_type
|
|||
For example, if tem is a Lisp_Object whose type is Lisp_Cons,
|
||||
XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
|
||||
|
||||
#ifndef USE_LISP_UNION_TYPE
|
||||
|
||||
/* Return a perfect hash of the Lisp_Object representation. */
|
||||
#define XHASH(a) (a)
|
||||
#define XHASH(a) XLI(a)
|
||||
|
||||
#if USE_LSB_TAG
|
||||
|
||||
#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
|
||||
#define XTYPE(a) ((enum Lisp_Type) ((a) & TYPEMASK))
|
||||
#define XTYPE(a) ((enum Lisp_Type) (XLI(a) & TYPEMASK))
|
||||
#ifdef USE_2_TAGS_FOR_INTS
|
||||
# define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1))
|
||||
# define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1))
|
||||
# define make_number(N) (((EMACS_INT) (N)) << (GCTYPEBITS - 1))
|
||||
# define XINT(a) (((EMACS_INT) XLI(a)) >> (GCTYPEBITS - 1))
|
||||
# define XUINT(a) (((EMACS_UINT) XLI(a)) >> (GCTYPEBITS - 1))
|
||||
# define make_number(N) XIL(((EMACS_INT) (N)) << (GCTYPEBITS - 1))
|
||||
#else
|
||||
# define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS)
|
||||
# define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
|
||||
# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
|
||||
# define XINT(a) (((EMACS_INT) XLI(a)) >> GCTYPEBITS)
|
||||
# define XUINT(a) (((EMACS_UINT) XLI(a)) >> GCTYPEBITS)
|
||||
# define make_number(N) XIL(((EMACS_INT) (N)) << GCTYPEBITS)
|
||||
#endif
|
||||
#define XSET(var, type, ptr) \
|
||||
(eassert (XTYPE ((intptr_t) (ptr)) == 0), /* Check alignment. */ \
|
||||
(var) = (type) | (intptr_t) (ptr))
|
||||
#define XSET(var, type, ptr) \
|
||||
(eassert (XTYPE (XIL((intptr_t) (ptr))) == 0), /* Check alignment. */ \
|
||||
(var) = XIL((type) | (intptr_t) (ptr)))
|
||||
|
||||
#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
|
||||
#define XUNTAG(a, type) ((intptr_t) ((a) - (type)))
|
||||
#define XPNTR(a) ((intptr_t) (XLI(a) & ~TYPEMASK))
|
||||
#define XUNTAG(a, type) ((intptr_t) (XLI(a) - (type)))
|
||||
|
||||
#else /* not USE_LSB_TAG */
|
||||
|
||||
|
|
@ -465,91 +446,42 @@ enum pvec_type
|
|||
(doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work
|
||||
on all machines, but would penalize machines which don't need it)
|
||||
*/
|
||||
#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) >> VALBITS))
|
||||
#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) XLI(a)) >> VALBITS))
|
||||
|
||||
/* For integers known to be positive, XFASTINT provides fast retrieval
|
||||
and XSETFASTINT provides fast storage. This takes advantage of the
|
||||
fact that Lisp_Int is 0. */
|
||||
#define XFASTINT(a) ((a) + 0)
|
||||
#define XSETFASTINT(a, b) ((a) = (b))
|
||||
#define XFASTINT(a) (XLI(a) + 0)
|
||||
#define XSETFASTINT(a, b) ((a) = XIL(b))
|
||||
|
||||
/* Extract the value of a Lisp_Object as a (un)signed integer. */
|
||||
|
||||
#ifdef USE_2_TAGS_FOR_INTS
|
||||
# define XINT(a) ((((EMACS_INT) (a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1))
|
||||
# define XUINT(a) ((EMACS_UINT) ((a) & (1 + (VALMASK << 1))))
|
||||
# define make_number(N) ((((EMACS_INT) (N)) & (1 + (VALMASK << 1))))
|
||||
# define XINT(a) ((((EMACS_INT) XLI(a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1))
|
||||
# define XUINT(a) ((EMACS_UINT) (XLI(a) & (1 + (VALMASK << 1))))
|
||||
# define make_number(N) XIL((((EMACS_INT) (N)) & (1 + (VALMASK << 1))))
|
||||
#else
|
||||
# define XINT(a) ((((EMACS_INT) (a)) << (BITS_PER_EMACS_INT - VALBITS)) \
|
||||
>> (BITS_PER_EMACS_INT - VALBITS))
|
||||
# define XUINT(a) ((EMACS_UINT) ((a) & VALMASK))
|
||||
# define XINT(a) ((((EMACS_INT) XLI(a)) << (BITS_PER_EMACS_INT - VALBITS)) \
|
||||
>> (BITS_PER_EMACS_INT - VALBITS))
|
||||
# define XUINT(a) ((EMACS_UINT) (XLI(a) & VALMASK))
|
||||
# define make_number(N) \
|
||||
((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
|
||||
XIL((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
|
||||
#endif
|
||||
|
||||
#define XSET(var, type, ptr) \
|
||||
((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
|
||||
+ ((intptr_t) (ptr) & VALMASK)))
|
||||
((var) = XIL((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
|
||||
+ ((intptr_t) (ptr) & VALMASK)))
|
||||
|
||||
#ifdef DATA_SEG_BITS
|
||||
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
|
||||
which were stored in a Lisp_Object */
|
||||
#define XPNTR(a) ((uintptr_t) (((a) & VALMASK)) | DATA_SEG_BITS))
|
||||
#define XPNTR(a) ((uintptr_t) ((XLI(a) & VALMASK)) | DATA_SEG_BITS))
|
||||
#else
|
||||
#define XPNTR(a) ((uintptr_t) ((a) & VALMASK))
|
||||
#define XPNTR(a) ((uintptr_t) (XLI(a) & VALMASK))
|
||||
#endif
|
||||
|
||||
#endif /* not USE_LSB_TAG */
|
||||
|
||||
#else /* USE_LISP_UNION_TYPE */
|
||||
|
||||
#ifdef USE_2_TAGS_FOR_INTS
|
||||
# error "USE_2_TAGS_FOR_INTS is not supported with USE_LISP_UNION_TYPE"
|
||||
#endif
|
||||
|
||||
#define XHASH(a) ((a).i)
|
||||
#define XTYPE(a) ((enum Lisp_Type) (a).u.type)
|
||||
#define XINT(a) ((EMACS_INT) (a).s.val)
|
||||
#define XUINT(a) ((EMACS_UINT) (a).u.val)
|
||||
|
||||
#if USE_LSB_TAG
|
||||
|
||||
# define XSET(var, vartype, ptr) \
|
||||
(eassert (((uintptr_t) (ptr) & ((1 << GCTYPEBITS) - 1)) == 0), \
|
||||
(var).u.val = (uintptr_t) (ptr) >> GCTYPEBITS, \
|
||||
(var).u.type = (vartype))
|
||||
|
||||
/* Some versions of gcc seem to consider the bitfield width when issuing
|
||||
the "cast to pointer from integer of different size" warning, so the
|
||||
cast is here to widen the value back to its natural size. */
|
||||
# define XPNTR(v) ((intptr_t) (v).s.val << GCTYPEBITS)
|
||||
|
||||
#else /* !USE_LSB_TAG */
|
||||
|
||||
# define XSET(var, vartype, ptr) \
|
||||
((var).s.val = (intptr_t) (ptr), (var).s.type = (vartype))
|
||||
|
||||
#ifdef DATA_SEG_BITS
|
||||
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
|
||||
which were stored in a Lisp_Object */
|
||||
#define XPNTR(a) ((intptr_t) (XUINT (a) | DATA_SEG_BITS))
|
||||
#else
|
||||
#define XPNTR(a) ((intptr_t) XUINT (a))
|
||||
#endif
|
||||
|
||||
#endif /* !USE_LSB_TAG */
|
||||
|
||||
static inline Lisp_Object
|
||||
make_number (EMACS_INT n)
|
||||
{
|
||||
Lisp_Object o;
|
||||
o.s.val = n;
|
||||
o.s.type = Lisp_Int;
|
||||
return o;
|
||||
}
|
||||
|
||||
#endif /* USE_LISP_UNION_TYPE */
|
||||
|
||||
/* For integers known to be positive, XFASTINT sometimes provides
|
||||
faster retrieval and XSETFASTINT provides faster storage.
|
||||
If not, fallback on the non-accelerated path. */
|
||||
|
|
|
|||
21
src/w32fns.c
21
src/w32fns.c
|
|
@ -6326,13 +6326,8 @@ The return value is the hotkey-id if registered, otherwise nil. */)
|
|||
|
||||
/* Notify input thread about new hot-key definition, so that it
|
||||
takes effect without needing to switch focus. */
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
|
||||
(WPARAM) key.i, 0);
|
||||
#else
|
||||
PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
|
||||
(WPARAM) key, 0);
|
||||
#endif
|
||||
(WPARAM) XLI (key), 0);
|
||||
}
|
||||
|
||||
return key;
|
||||
|
|
@ -6354,13 +6349,8 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
|
|||
{
|
||||
/* Notify input thread about hot-key definition being removed, so
|
||||
that it takes effect without needing focus switch. */
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
|
||||
(WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
|
||||
#else
|
||||
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
|
||||
(WPARAM) XINT (XCAR (item)), (LPARAM) item))
|
||||
#endif
|
||||
(WPARAM) XINT (XCAR (item)), (LPARAM) XLI (item)))
|
||||
{
|
||||
MSG msg;
|
||||
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
|
||||
|
|
@ -6432,13 +6422,8 @@ is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
|
|||
if (!dwWindowsThreadId)
|
||||
return make_number (w32_console_toggle_lock_key (vk_code, new_state));
|
||||
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
|
||||
(WPARAM) vk_code, (LPARAM) new_state.i))
|
||||
#else
|
||||
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
|
||||
(WPARAM) vk_code, (LPARAM) new_state))
|
||||
#endif
|
||||
(WPARAM) vk_code, (LPARAM) XLI (new_state)))
|
||||
{
|
||||
MSG msg;
|
||||
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@ get_data_end (void)
|
|||
return data_region_end;
|
||||
}
|
||||
|
||||
#if !defined USE_LISP_UNION_TYPE && !USE_LSB_TAG
|
||||
#if !USE_LSB_TAG
|
||||
static char *
|
||||
allocate_heap (void)
|
||||
{
|
||||
|
|
@ -141,7 +141,7 @@ allocate_heap (void)
|
|||
|
||||
return ptr;
|
||||
}
|
||||
#else /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
|
||||
#else /* USE_LSB_TAG */
|
||||
static char *
|
||||
allocate_heap (void)
|
||||
{
|
||||
|
|
@ -160,7 +160,7 @@ allocate_heap (void)
|
|||
|
||||
return ptr;
|
||||
}
|
||||
#endif /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
|
||||
#endif /* USE_LSB_TAG */
|
||||
|
||||
|
||||
/* Emulate Unix sbrk. Note that ralloc.c expects the return value to
|
||||
|
|
@ -259,7 +259,7 @@ init_heap (void)
|
|||
exit (1);
|
||||
}
|
||||
|
||||
#if !defined USE_LISP_UNION_TYPE && !USE_LSB_TAG
|
||||
#if !USE_LSB_TAG
|
||||
/* Ensure that the addresses don't use the upper tag bits since
|
||||
the Lisp type goes there. */
|
||||
if (((unsigned long) data_region_base & ~VALMASK) != 0)
|
||||
|
|
|
|||
|
|
@ -1533,11 +1533,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
|
|||
until it is ready to be displayed, since GC can happen while
|
||||
menus are active. */
|
||||
if (!NILP (wv->help))
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
info.dwItemData = (DWORD) (wv->help).i;
|
||||
#else
|
||||
info.dwItemData = (DWORD) (wv->help);
|
||||
#endif
|
||||
info.dwItemData = (DWORD) XLI (wv->help);
|
||||
if (wv->button_type == BUTTON_TYPE_RADIO)
|
||||
{
|
||||
/* CheckMenuRadioItem allows us to differentiate TOGGLE and
|
||||
|
|
@ -1612,12 +1608,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
|
|||
info.fMask = MIIM_DATA;
|
||||
get_menu_item_info (menu, item, FALSE, &info);
|
||||
|
||||
#ifdef USE_LISP_UNION_TYPE
|
||||
help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
|
||||
: Qnil;
|
||||
#else
|
||||
help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
|
||||
#endif
|
||||
help = info.dwItemData ? XIL (info.dwItemData) : Qnil;
|
||||
}
|
||||
|
||||
/* Store the help echo in the keyboard buffer as the X toolkit
|
||||
|
|
|
|||
|
|
@ -4342,7 +4342,7 @@ w32_read_socket (struct terminal *terminal, int expected,
|
|||
|
||||
/* If the contents of the global variable help_echo_string
|
||||
has changed, generate a HELP_EVENT. */
|
||||
#if 0 /* The below is an invalid comparison when USE_LISP_UNION_TYPE.
|
||||
#if 0 /* The below is an invalid comparison when CHECK_LISP_OBJECT_TYPE.
|
||||
But it was originally changed to this to fix a bug, so I have
|
||||
not removed it completely in case the bug is still there. */
|
||||
if (help_echo_string != previous_help_echo_string ||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue