+2011-04-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer intptr_t/uintptr_t for integers the same widths as pointers.
+ This removes an assumption that EMACS_INT and long are the same
+ width as pointers. The assumption is true for Emacs porting targets
+ now, but we want to make other targets possible.
+ * lisp.h: Include <inttypes.h>, for INTPTR_MAX, UINTPTR_MAX.
+ (EMACS_INTPTR, EMACS_UINTPTR): New macros.
+ In the rest of the code, change types of integers that hold casted
+ pointers to EMACS_INTPTR and EMACS_UINTPTR, systematically
+ replacing EMACS_INT, long, EMACS_UINT, and unsigned long.
+ (XTYPE): Don't cast arg to EMACS_UINT; normally is not needed.
+ (XSET): Cast type of XTYPE arg to EMACS_INTPTR; it is needed here.
+ No need to cast type when ORing.
+ (XPNTR): Return a value of type EMACS_INTPTR or EMACS_UINTPTR.
+ * alloc.c (lisp_align_malloc): Remove a no-longer-needed cast.
+ * doc.c (store_function_docstring): Use EMACS_INTPTR, so as not to
+ assume EMACS_INT is the same width as char *.
+ * gtkutil.c (xg_gtk_scroll_destroy, xg_tool_bar_button_cb):
+ (xg_tool_bar_callback, xg_tool_bar_help_callback, xg_make_tool_item):
+ Remove no-longer-needed casts.
+ (xg_create_scroll_bar, xg_tool_bar_button_cb, xg_tool_bar_callback):
+ (xg_tool_bar_help_callback, xg_make_tool_item):
+ Use EMACS_INTPTR to hold an integer
+ that will be cast to void *; this can avoid a GCC warning
+ if EMACS_INT is not the same width as void *.
+ * menu.c (find_and_call_menu_selection): Remove no-longer-needed cast.
+ * xdisp.c (display_echo_area_1, resize_mini_window_1):
+ (current_message_1, set_message_1):
+ Use a local to convert to proper width without a cast.
+ * xmenu.c (dialog_selection_callback): Likewise.
+
2011-04-28 Paul Eggert <eggert@cs.ucla.edu>
* sysdep.c (get_random): Don't assume EMACS_INT is no wider than long.
ALIGNMENT must be a power of 2. */
#define ALIGN(ptr, ALIGNMENT) \
- ((POINTER_TYPE *) ((((EMACS_UINT)(ptr)) + (ALIGNMENT) - 1) \
+ ((POINTER_TYPE *) ((((EMACS_UINTPTR) (ptr)) + (ALIGNMENT) - 1) \
& ~((ALIGNMENT) - 1)))
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
- (((unsigned long) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
+ (((EMACS_UINTPTR) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
? (struct ablocks *)(block) \
: (block)->abase)
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
- (1 & (long) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
+ (1 & (EMACS_INTPTR) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
#endif
/* The list of free ablock. */
if (!free_ablock)
{
int i;
- EMACS_INT aligned; /* int gets warning casting to 64-bit pointer. */
+ EMACS_INTPTR aligned; /* int gets warning casting to 64-bit pointer. */
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
abase->blocks[i].x.next_free = free_ablock;
free_ablock = &abase->blocks[i];
}
- ABLOCKS_BUSY (abase) = (struct ablocks *) (long) aligned;
+ ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
- eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
+ eassert (0 == ((EMACS_UINTPTR) abase) % BLOCK_ALIGN);
eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
eassert (ABLOCKS_BASE (abase) == base);
- eassert (aligned == (long) ABLOCKS_BUSY (abase));
+ eassert (aligned == (EMACS_INTPTR) ABLOCKS_BUSY (abase));
}
abase = ABLOCK_ABASE (free_ablock);
- ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (long) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase) =
+ (struct ablocks *) (2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase));
val = free_ablock;
free_ablock = free_ablock->x.next_free;
if (!val && nbytes)
memory_full ();
- eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
+ eassert (0 == ((EMACS_UINTPTR) val) % BLOCK_ALIGN);
return val;
}
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase) =
+ (struct ablocks *) (-2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase));
- if (2 > (long) ABLOCKS_BUSY (abase))
+ if (2 > (EMACS_INTPTR) ABLOCKS_BUSY (abase))
{ /* All the blocks are free. */
- int i = 0, aligned = (long) ABLOCKS_BUSY (abase);
+ int i = 0, aligned = (EMACS_INTPTR) ABLOCKS_BUSY (abase);
struct ablock **tem = &free_ablock;
struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
eassert ((aligned & 1) == aligned);
eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
#ifdef USE_POSIX_MEMALIGN
- eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
+ eassert ((EMACS_UINTPTR) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
#endif
free (ABLOCKS_BASE (abase));
}
s = string_free_list;
while (s != NULL)
{
- if ((unsigned long)s < 1024)
+ if ((EMACS_UINTPTR) s < 1024)
abort();
s = NEXT_FREE_LISP_STRING (s);
}
&= ~(1 << ((n) % (sizeof(int) * CHAR_BIT)))
#define FLOAT_BLOCK(fptr) \
- ((struct float_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+ ((struct float_block *) (((EMACS_UINTPTR) (fptr)) & ~(BLOCK_ALIGN - 1)))
#define FLOAT_INDEX(fptr) \
- ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
+ ((((EMACS_UINTPTR) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
struct float_block
{
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
#define CONS_BLOCK(fptr) \
- ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+ ((struct cons_block *) ((EMACS_UINTPTR) (fptr) & ~(BLOCK_ALIGN - 1)))
#define CONS_INDEX(fptr) \
- ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
+ (((EMACS_UINTPTR) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
struct cons_block
{
struct mem_node *m;
/* Quickly rule out some values which can't point to Lisp data. */
- if ((EMACS_INT) p %
+ if ((EMACS_INTPTR) p %
#ifdef USE_LSB_TAG
8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
#else
{
Lisp_Object end;
- XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024);
+ XSETINT (end, (EMACS_INTPTR) (char *) sbrk (0) / 1024);
return end;
}
return Qnil;
/* FIXME: This is not portable, as it assumes that string
pointers have the top bit clear. */
- else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+ else if ((EMACS_INTPTR) XSUBR (fun)->doc >= 0)
doc = build_string (XSUBR (fun)->doc);
else
- doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
+ doc = make_number ((EMACS_INTPTR) XSUBR (fun)->doc);
}
else if (COMPILEDP (fun))
{
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
- if (SUBRP (fun))
- XSUBR (fun)->doc = (char *) - offset;
+ if (SUBRP (fun))
+ {
+ EMACS_INTPTR negative_offset = - offset;
+ XSUBR (fun)->doc = (char *) negative_offset;
+ }
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
static void
xg_gtk_scroll_destroy (GtkWidget *widget, gpointer data)
{
- int id = (int) (EMACS_INT) data; /* The EMACS_INT cast avoids a warning. */
+ int id = (EMACS_INTPTR) data;
xg_remove_widget_from_map (id);
}
{
GtkWidget *wscroll;
GtkWidget *webox;
- int scroll_id;
+ EMACS_INTPTR scroll_id;
#ifdef HAVE_GTK3
GtkAdjustment *vadj;
#else
scroll_id = xg_store_widget_in_map (wscroll);
- /* The EMACS_INT cast avoids a warning. */
g_signal_connect (G_OBJECT (wscroll),
"destroy",
G_CALLBACK (xg_gtk_scroll_destroy),
- (gpointer) (EMACS_INT) scroll_id);
+ (gpointer) scroll_id);
g_signal_connect (G_OBJECT (wscroll),
"change-value",
scroll_callback,
GdkEventButton *event,
gpointer user_data)
{
- /* Casts to avoid warnings when gpointer is 64 bits and int is 32 bits */
- gpointer ptr = (gpointer) (EMACS_INT) event->state;
+ EMACS_INTPTR state = event->state;
+ gpointer ptr = (gpointer) state;
g_object_set_data (G_OBJECT (widget), XG_TOOL_BAR_LAST_MODIFIER, ptr);
return FALSE;
}
static void
xg_tool_bar_callback (GtkWidget *w, gpointer client_data)
{
- /* The EMACS_INT cast avoids a warning. */
- int idx = (int) (EMACS_INT) client_data;
+ EMACS_INTPTR idx = (EMACS_INTPTR) client_data;
gpointer gmod = g_object_get_data (G_OBJECT (w), XG_TOOL_BAR_LAST_MODIFIER);
- int mod = (int) (EMACS_INT) gmod;
+ EMACS_INTPTR mod = (EMACS_INTPTR) gmod;
FRAME_PTR f = (FRAME_PTR) g_object_get_data (G_OBJECT (w), XG_FRAME_DATA);
Lisp_Object key, frame;
GdkEventCrossing *event,
gpointer client_data)
{
- /* The EMACS_INT cast avoids a warning. */
- int idx = (int) (EMACS_INT) client_data;
+ EMACS_INTPTR idx = (EMACS_INTPTR) client_data;
FRAME_PTR f = (FRAME_PTR) g_object_get_data (G_OBJECT (w), XG_FRAME_DATA);
Lisp_Object help, frame;
if (wimage)
{
- /* The EMACS_INT cast avoids a warning. */
+ EMACS_INTPTR ii = i;
+ gpointer gi = (gpointer) ii;
+
g_signal_connect (G_OBJECT (ti), "create-menu-proxy",
G_CALLBACK (xg_tool_bar_menu_proxy),
- (gpointer) (EMACS_INT) i);
+ gi);
g_signal_connect (G_OBJECT (wb), "clicked",
G_CALLBACK (xg_tool_bar_callback),
- (gpointer) (EMACS_INT) i);
+ gi);
g_object_set_data (G_OBJECT (weventbox), XG_FRAME_DATA, (gpointer)f);
g_signal_connect (G_OBJECT (weventbox),
"enter-notify-event",
G_CALLBACK (xg_tool_bar_help_callback),
- (gpointer) (EMACS_INT) i);
+ gi);
g_signal_connect (G_OBJECT (weventbox),
"leave-notify-event",
G_CALLBACK (xg_tool_bar_help_callback),
- (gpointer) (EMACS_INT) i);
+ gi);
}
if (wbutton) *wbutton = wb;
#include <stdarg.h>
#include <stddef.h>
+#include <inttypes.h>
/* Use the configure flag --enable-checking[=LIST] to enable various
types of run time checks for Lisp objects. */
#endif
#endif
+/* Integers large enough to hold casted pointers without losing info. */
+#ifdef INTPTR_MAX
+# define EMACS_INTPTR intptr_t
+#else
+# define EMACS_INTPTR EMACS_INT
+#endif
+#ifdef UINTPTR_MAX
+# define EMACS_UINTPTR uintptr_t
+#else
+# define EMACS_UINTPTR EMACS_UINT
+#endif
+
/* Extra internal type checking? */
#ifdef ENABLE_CHECKING
#ifdef USE_LSB_TAG
#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
-#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) & TYPEMASK))
+#define XTYPE(a) ((enum Lisp_Type) ((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 XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
#endif
-#define XSET(var, type, ptr) \
- (eassert (XTYPE (ptr) == 0), /* Check alignment. */ \
- (var) = ((EMACS_INT) (type)) | ((EMACS_INT) (ptr)))
+#define XSET(var, type, ptr) \
+ (eassert (XTYPE ((EMACS_INTPTR) (ptr)) == 0), /* Check alignment. */ \
+ (var) = (type) | (EMACS_INTPTR) (ptr))
-#define XPNTR(a) ((EMACS_INT) ((a) & ~TYPEMASK))
+#define XPNTR(a) ((EMACS_INTPTR) ((a) & ~TYPEMASK))
#else /* not USE_LSB_TAG */
#define XSET(var, type, ptr) \
((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((EMACS_INT) (ptr) & VALMASK)))
+ + ((EMACS_INTPTR) (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) ((EMACS_UINT) (((a) & VALMASK) | DATA_SEG_BITS))
+#define XPNTR(a) ((EMACS_UINTPTR) (((a) & VALMASK)) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_UINT) ((a) & VALMASK))
+#define XPNTR(a) ((EMACS_UINTPTR) ((a) & VALMASK))
#endif
#endif /* not USE_LSB_TAG */
/* 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) ((EMACS_INT)((v).s.val) << GCTYPEBITS)
+# define XPNTR(v) ((EMACS_INTPTR) (v).s.val << GCTYPEBITS)
#else /* !USE_LSB_TAG */
#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) (XUINT (a) | DATA_SEG_BITS)
+#define XPNTR(a) ((EMACS_INTPTR) (XUINT (a) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_INT) XUINT (a))
+#define XPNTR(a) ((EMACS_INTPTR) XUINT (a))
#endif
#endif /* !USE_LSB_TAG */
XSETCDR ((x), tmp); \
} while (0)
-/* Cast pointers to this type to compare them. Some machines want int. */
-#define PNTR_COMPARISON_TYPE EMACS_UINT
+/* Cast pointers to this type to compare them. */
+#define PNTR_COMPARISON_TYPE EMACS_UINTPTR
\f
/* Define a built-in function for calling from Lisp.
`lname' should be the name to give the function in Lisp,
if (!NILP (descrip))
wv->lkey = descrip;
wv->value = 0;
- /* The EMACS_INT cast avoids a warning. There's no problem
+ /* The EMACS_INTPTR cast avoids a warning. There's no problem
as long as pointers have enough bits to hold small integers. */
- wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
+ wv->call_data = (!NILP (def) ? (void *) (EMACS_INTPTR) i : 0);
wv->enabled = !NILP (enable);
if (NILP (type))
else
{
entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
- /* The EMACS_INT cast avoids a warning. There's no problem
+ /* Treat the pointer as an integer. There's no problem
as long as pointers have enough bits to hold small integers. */
- if ((int) (EMACS_INT) client_data == i)
+ if ((EMACS_INTPTR) client_data == i)
{
int j;
struct input_event buf;
window_height_changed_p
= with_echo_area_buffer (w, display_last_displayed_message_p,
display_echo_area_1,
- (EMACS_INT) w, Qnil, 0, 0);
+ (EMACS_INTPTR) w, Qnil, 0, 0);
if (no_message_p)
echo_area_buffer[i] = Qnil;
static int
display_echo_area_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
{
- struct window *w = (struct window *) a1;
+ EMACS_INTPTR i1 = a1;
+ struct window *w = (struct window *) i1;
Lisp_Object window;
struct text_pos start;
int window_height_changed_p = 0;
resize_exactly = Qnil;
resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1,
- (EMACS_INT) w, resize_exactly, 0, 0);
+ (EMACS_INTPTR) w, resize_exactly,
+ 0, 0);
if (resized_p)
{
++windows_or_buffers_changed;
static int
resize_mini_window_1 (EMACS_INT a1, Lisp_Object exactly, EMACS_INT a3, EMACS_INT a4)
{
- return resize_mini_window ((struct window *) a1, !NILP (exactly));
+ EMACS_INTPTR i1 = a1;
+ return resize_mini_window ((struct window *) i1, !NILP (exactly));
}
else
{
with_echo_area_buffer (0, 0, current_message_1,
- (EMACS_INT) &msg, Qnil, 0, 0);
+ (EMACS_INTPTR) &msg, Qnil, 0, 0);
if (NILP (msg))
echo_area_buffer[0] = Qnil;
}
static int
current_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
{
- Lisp_Object *msg = (Lisp_Object *) a1;
+ EMACS_INTPTR i1 = a1;
+ Lisp_Object *msg = (Lisp_Object *) i1;
if (Z > BEG)
*msg = make_buffer_string (BEG, Z, 1);
|| (STRINGP (string) && STRING_MULTIBYTE (string)));
with_echo_area_buffer (0, -1, set_message_1,
- (EMACS_INT) s, string, nbytes, multibyte_p);
+ (EMACS_INTPTR) s, string, nbytes, multibyte_p);
message_buf_print = 0;
help_echo_showing_p = 0;
}
static int
set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multibyte_p)
{
- const char *s = (const char *) a1;
+ EMACS_INTPTR i1 = a1;
+ const char *s = (const char *) i1;
const unsigned char *msg = (const unsigned char *) s;
Lisp_Object string = a2;
wv->help = Qnil;
/* This prevents lwlib from assuming this
menu item is really supposed to be empty. */
- /* The EMACS_INT cast avoids a warning.
+ /* The EMACS_INTPTR cast avoids a warning.
This value just has to be different from small integers. */
- wv->call_data = (void *) (EMACS_INT) (-1);
+ wv->call_data = (void *) (EMACS_INTPTR) (-1);
if (prev_wv)
prev_wv->next = wv;
static void
dialog_selection_callback (GtkWidget *widget, gpointer client_data)
{
- /* The EMACS_INT cast avoids a warning. There's no problem
+ /* Treat the pointer as an integer. There's no problem
as long as pointers have enough bits to hold small integers. */
- if ((int) (EMACS_INT) client_data != -1)
+ if ((EMACS_INTPTR) client_data != -1)
menu_item_selection = (Lisp_Object *) client_data;
popup_activated_flag = 0;
HCoop / bpt / emacs.git / commitdiff