carbon2-commit: changes to VOID_TO_LISP et al.
Ben Wing
ben at xemacs.org
Fri Mar 5 12:46:48 EST 2010
changeset: 5063:ae48681c47fa
user: Ben Wing <ben at xemacs.org>
date: Mon Feb 08 06:42:16 2010 -0600
files: src/ChangeLog src/casetab.c src/chartab.c src/console.c src/device.c src/dialog-msw.c src/dialog-x.c src/eval.c src/event-msw.c src/faces.c src/frame-msw.c src/glade.c src/glyphs-msw.c src/glyphs.c src/gui-x.c src/keymap.c src/lisp-disunion.h src/lisp-union.h src/lisp.h src/menubar-gtk.c src/menubar-msw.c src/menubar-x.c src/print.c src/process-unix.c src/process.c src/profile.c src/scrollbar-msw.c src/specifier.c src/syntax.c src/tests.c src/text.c src/text.h src/tooltalk.c src/ui-byhand.c src/ui-gtk.c
description:
changes to VOID_TO_LISP et al.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben at xemacs.org>
* casetab.c (compute_canon_mapper):
* casetab.c (initialize_identity_mapper):
* casetab.c (compute_up_or_eqv_mapper):
* casetab.c (recompute_case_table):
* casetab.c (set_case_table):
* chartab.c (copy_mapper):
* chartab.c (copy_char_table_range):
* chartab.c (get_range_char_table_1):
* console.c (find_nonminibuffer_frame_not_on_console_predicate):
* console.c (find_nonminibuffer_frame_not_on_console):
* console.c (nuke_all_console_slots):
* device.c:
* device.c (find_nonminibuffer_frame_not_on_device_predicate):
* device.c (find_nonminibuffer_frame_not_on_device):
* dialog-msw.c (dialog_proc):
* dialog-msw.c (handle_question_dialog_box):
* dialog-x.c (maybe_run_dbox_text_callback):
* eval.c:
* eval.c (safe_run_hook_trapping_problems_1):
* eval.c (safe_run_hook_trapping_problems):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (mswindows_find_frame):
* faces.c (update_face_inheritance_mapper):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_get_mouse_position):
* frame-msw.c (mswindows_get_frame_parent):
* glade.c (connector):
* glade.c (Fglade_xml_signal_connect):
* glade.c (Fglade_xml_signal_autoconnect):
* glade.c (Fglade_xml_textdomain):
* glyphs-msw.c (mswindows_subwindow_instantiate):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs.c (check_instance_cache_mapper):
* glyphs.c (check_window_subwindow_cache):
* glyphs.c (check_image_instance_structure):
* gui-x.c (snarf_widget_value_mapper):
* gui-x.c (popup_selection_callback):
* gui-x.c (button_item_to_widget_value):
* keymap.c (map_keymap_mapper):
* keymap.c (Fmap_keymap):
* menubar-gtk.c (__torn_off_sir):
* menubar-gtk.c (__activate_menu):
* menubar-gtk.c (menu_convert):
* menubar-gtk.c (__generic_button_callback):
* menubar-gtk.c (menu_descriptor_to_widget_1):
* menubar-msw.c:
* menubar-msw.c (EMPTY_ITEM_ID):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* menubar-x.c (pre_activate_callback):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar-x.c (command_builder_find_menu_accelerator):
* print.c (print_internal):
* process-unix.c (close_process_descs_mapfun):
* process.c (get_process_from_usid):
* process.c (init_process_io_handles):
* profile.c (sigprof_handler):
* profile.c (get_profiling_info_timing_maphash):
* profile.c (Fget_profiling_info):
* profile.c (set_profiling_info_timing_maphash):
* profile.c (mark_profiling_info_maphash):
* scrollbar-msw.c (mswindows_create_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (mswindows_handle_scrollbar_event):
* specifier.c (recompute_cached_specifier_everywhere_mapfun):
* specifier.c (recompute_cached_specifier_everywhere):
* syntax.c (copy_to_mirrortab):
* syntax.c (copy_if_not_already_present):
* syntax.c (update_just_this_syntax_table):
* text.c (new_dfc_convert_now_damn_it):
* text.h (LISP_STRING_TO_EXTERNAL):
* tooltalk.c:
* tooltalk.c (tooltalk_message_callback):
* tooltalk.c (tooltalk_pattern_callback):
* tooltalk.c (Fcreate_tooltalk_message):
* tooltalk.c (Fcreate_tooltalk_pattern):
* ui-byhand.c (__generic_toolbar_callback):
* ui-byhand.c (generic_toolbar_insert_item):
* ui-byhand.c (__emacs_gtk_ctree_recurse_internal):
* ui-byhand.c (Fgtk_ctree_recurse):
* ui-gtk.c (__internal_callback_destroy):
* ui-gtk.c (__internal_callback_marshal):
* ui-gtk.c (Fgtk_signal_connect):
* ui-gtk.c (gtk_type_to_lisp):
* ui-gtk.c (lisp_to_gtk_type):
* ui-gtk.c (lisp_to_gtk_ret_type):
* lisp-disunion.h:
* lisp-disunion.h (NON_LVALUE):
* lisp-union.h:
* lisp.h (LISP_HASH):
Rename:
LISP_TO_VOID -> STORE_LISP_IN_VOID
VOID_TO_LISP -> GET_LISP_FROM_VOID
These new names are meant to clearly identify that the Lisp object
is the source and void the sink, and that they can't be used the
other way around -- they aren't exact opposites despite the old
names. The names are also important given the new functions
created just below. Also, clarify comments in lisp-union.h and
lisp-disunion.h about the use of the functions.
* lisp.h:
New functions STORE_VOID_IN_LISP and GET_VOID_FROM_LISP. These
are different from the above in that the source is a void *
(previously, you had to use make_opaque_ptr()).
* eval.c (restore_lisp_object):
* eval.c (record_unwind_protect_restoring_lisp_object):
* eval.c (struct restore_int):
* eval.c (restore_int):
* eval.c (record_unwind_protect_restoring_int):
* eval.c (free_pointer):
* eval.c (record_unwind_protect_freeing):
* eval.c (free_dynarr):
* eval.c (record_unwind_protect_freeing_dynarr):
* eval.c (unbind_to_1):
Use STORE_VOID_IN_LISP and GET_VOID_FROM_LISP to eliminate the
use of make_opaque_ptr() and mostly eliminate Lisp consing
entirely in the use of these various record_unwind_protect_*
functions as well as internal_bind_* (e.g. internal_bind_int).
* tests.c:
* tests.c (Ftest_store_void_in_lisp):
* tests.c (syms_of_tests):
* tests.c (vars_of_tests):
Add an C-assert-style test to test STORE_VOID_IN_LISP and
GET_VOID_FROM_LISP to make sure the same value comes back that
was put in.
diff -r f68b2ec914e3 -r ae48681c47fa src/ChangeLog
--- a/src/ChangeLog Mon Feb 08 04:47:56 2010 -0600
+++ b/src/ChangeLog Mon Feb 08 06:42:16 2010 -0600
@@ -1,3 +1,135 @@
+2010-02-08 Ben Wing <ben at xemacs.org>
+
+ * casetab.c (compute_canon_mapper):
+ * casetab.c (initialize_identity_mapper):
+ * casetab.c (compute_up_or_eqv_mapper):
+ * casetab.c (recompute_case_table):
+ * casetab.c (set_case_table):
+ * chartab.c (copy_mapper):
+ * chartab.c (copy_char_table_range):
+ * chartab.c (get_range_char_table_1):
+ * console.c (find_nonminibuffer_frame_not_on_console_predicate):
+ * console.c (find_nonminibuffer_frame_not_on_console):
+ * console.c (nuke_all_console_slots):
+ * device.c:
+ * device.c (find_nonminibuffer_frame_not_on_device_predicate):
+ * device.c (find_nonminibuffer_frame_not_on_device):
+ * dialog-msw.c (dialog_proc):
+ * dialog-msw.c (handle_question_dialog_box):
+ * dialog-x.c (maybe_run_dbox_text_callback):
+ * eval.c:
+ * eval.c (safe_run_hook_trapping_problems_1):
+ * eval.c (safe_run_hook_trapping_problems):
+ * event-msw.c:
+ * event-msw.c (mswindows_wnd_proc):
+ * event-msw.c (mswindows_find_frame):
+ * faces.c (update_face_inheritance_mapper):
+ * frame-msw.c (mswindows_init_frame_1):
+ * frame-msw.c (mswindows_get_mouse_position):
+ * frame-msw.c (mswindows_get_frame_parent):
+ * glade.c (connector):
+ * glade.c (Fglade_xml_signal_connect):
+ * glade.c (Fglade_xml_signal_autoconnect):
+ * glade.c (Fglade_xml_textdomain):
+ * glyphs-msw.c (mswindows_subwindow_instantiate):
+ * glyphs-msw.c (mswindows_widget_instantiate):
+ * glyphs.c (check_instance_cache_mapper):
+ * glyphs.c (check_window_subwindow_cache):
+ * glyphs.c (check_image_instance_structure):
+ * gui-x.c (snarf_widget_value_mapper):
+ * gui-x.c (popup_selection_callback):
+ * gui-x.c (button_item_to_widget_value):
+ * keymap.c (map_keymap_mapper):
+ * keymap.c (Fmap_keymap):
+ * menubar-gtk.c (__torn_off_sir):
+ * menubar-gtk.c (__activate_menu):
+ * menubar-gtk.c (menu_convert):
+ * menubar-gtk.c (__generic_button_callback):
+ * menubar-gtk.c (menu_descriptor_to_widget_1):
+ * menubar-msw.c:
+ * menubar-msw.c (EMPTY_ITEM_ID):
+ * menubar-x.c (menu_item_descriptor_to_widget_value_1):
+ * menubar-x.c (pre_activate_callback):
+ * menubar-x.c (command_builder_operate_menu_accelerator):
+ * menubar-x.c (command_builder_find_menu_accelerator):
+ * print.c (print_internal):
+ * process-unix.c (close_process_descs_mapfun):
+ * process.c (get_process_from_usid):
+ * process.c (init_process_io_handles):
+ * profile.c (sigprof_handler):
+ * profile.c (get_profiling_info_timing_maphash):
+ * profile.c (Fget_profiling_info):
+ * profile.c (set_profiling_info_timing_maphash):
+ * profile.c (mark_profiling_info_maphash):
+ * scrollbar-msw.c (mswindows_create_scrollbar_instance):
+ * scrollbar-msw.c (mswindows_free_scrollbar_instance):
+ * scrollbar-msw.c (mswindows_handle_scrollbar_event):
+ * specifier.c (recompute_cached_specifier_everywhere_mapfun):
+ * specifier.c (recompute_cached_specifier_everywhere):
+ * syntax.c (copy_to_mirrortab):
+ * syntax.c (copy_if_not_already_present):
+ * syntax.c (update_just_this_syntax_table):
+ * text.c (new_dfc_convert_now_damn_it):
+ * text.h (LISP_STRING_TO_EXTERNAL):
+ * tooltalk.c:
+ * tooltalk.c (tooltalk_message_callback):
+ * tooltalk.c (tooltalk_pattern_callback):
+ * tooltalk.c (Fcreate_tooltalk_message):
+ * tooltalk.c (Fcreate_tooltalk_pattern):
+ * ui-byhand.c (__generic_toolbar_callback):
+ * ui-byhand.c (generic_toolbar_insert_item):
+ * ui-byhand.c (__emacs_gtk_ctree_recurse_internal):
+ * ui-byhand.c (Fgtk_ctree_recurse):
+ * ui-gtk.c (__internal_callback_destroy):
+ * ui-gtk.c (__internal_callback_marshal):
+ * ui-gtk.c (Fgtk_signal_connect):
+ * ui-gtk.c (gtk_type_to_lisp):
+ * ui-gtk.c (lisp_to_gtk_type):
+ * ui-gtk.c (lisp_to_gtk_ret_type):
+ * lisp-disunion.h:
+ * lisp-disunion.h (NON_LVALUE):
+ * lisp-union.h:
+ * lisp.h (LISP_HASH):
+ Rename:
+
+ LISP_TO_VOID -> STORE_LISP_IN_VOID
+ VOID_TO_LISP -> GET_LISP_FROM_VOID
+
+ These new names are meant to clearly identify that the Lisp object
+ is the source and void the sink, and that they can't be used the
+ other way around -- they aren't exact opposites despite the old
+ names. The names are also important given the new functions
+ created just below. Also, clarify comments in lisp-union.h and
+ lisp-disunion.h about the use of the functions.
+
+ * lisp.h:
+ New functions STORE_VOID_IN_LISP and GET_VOID_FROM_LISP. These
+ are different from the above in that the source is a void *
+ (previously, you had to use make_opaque_ptr()).
+
+ * eval.c (restore_lisp_object):
+ * eval.c (record_unwind_protect_restoring_lisp_object):
+ * eval.c (struct restore_int):
+ * eval.c (restore_int):
+ * eval.c (record_unwind_protect_restoring_int):
+ * eval.c (free_pointer):
+ * eval.c (record_unwind_protect_freeing):
+ * eval.c (free_dynarr):
+ * eval.c (record_unwind_protect_freeing_dynarr):
+ * eval.c (unbind_to_1):
+ Use STORE_VOID_IN_LISP and GET_VOID_FROM_LISP to eliminate the
+ use of make_opaque_ptr() and mostly eliminate Lisp consing
+ entirely in the use of these various record_unwind_protect_*
+ functions as well as internal_bind_* (e.g. internal_bind_int).
+
+ * tests.c:
+ * tests.c (Ftest_store_void_in_lisp):
+ * tests.c (syms_of_tests):
+ * tests.c (vars_of_tests):
+ Add an C-assert-style test to test STORE_VOID_IN_LISP and
+ GET_VOID_FROM_LISP to make sure the same value comes back that
+ was put in.
+
2010-02-07 Ben Wing <ben at xemacs.org>
* fns.c: Qlist, Qstring mistakenly declared twice.
diff -r f68b2ec914e3 -r ae48681c47fa src/casetab.c
--- a/src/casetab.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/casetab.c Mon Feb 08 06:42:16 2010 -0600
@@ -304,7 +304,7 @@
compute_canon_mapper (struct chartab_range *range,
Lisp_Object UNUSED (table), Lisp_Object val, void *arg)
{
- Lisp_Object casetab = VOID_TO_LISP (arg);
+ Lisp_Object casetab = GET_LISP_FROM_VOID (arg);
if (range->type == CHARTAB_RANGE_CHAR)
SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch,
TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab),
@@ -319,7 +319,7 @@
Lisp_Object UNUSED (table),
Lisp_Object UNUSED (val), void *arg)
{
- Lisp_Object trt = VOID_TO_LISP (arg);
+ Lisp_Object trt = GET_LISP_FROM_VOID (arg);
if (range->type == CHARTAB_RANGE_CHAR)
SET_TRT_TABLE_OF (trt, range->ch, range->ch);
@@ -331,7 +331,7 @@
Lisp_Object UNUSED (table),
Lisp_Object val, void *arg)
{
- Lisp_Object inverse = VOID_TO_LISP (arg);
+ Lisp_Object inverse = GET_LISP_FROM_VOID (arg);
Ichar toch = XCHAR (val);
if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch)
@@ -361,13 +361,13 @@
retrieving the values below! */
XCASE_TABLE (casetab)->dirty = 0;
map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
- compute_canon_mapper, LISP_TO_VOID (casetab));
+ compute_canon_mapper, STORE_LISP_IN_VOID (casetab));
map_char_table (XCASE_TABLE_CANON (casetab), &range,
initialize_identity_mapper,
- LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
map_char_table (XCASE_TABLE_CANON (casetab), &range,
compute_up_or_eqv_mapper,
- LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
}
DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
@@ -436,17 +436,17 @@
{
map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
initialize_identity_mapper,
- LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab)));
map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
compute_up_or_eqv_mapper,
- LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab)));
}
else
convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up);
if (NILP (canon))
map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
- compute_canon_mapper, LISP_TO_VOID (casetab));
+ compute_canon_mapper, STORE_LISP_IN_VOID (casetab));
else
convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon);
@@ -454,10 +454,10 @@
{
map_char_table (XCASE_TABLE_CANON (casetab), &range,
initialize_identity_mapper,
- LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
map_char_table (XCASE_TABLE_CANON (casetab), &range,
compute_up_or_eqv_mapper,
- LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
+ STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
}
else
convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv);
diff -r f68b2ec914e3 -r ae48681c47fa src/chartab.c
--- a/src/chartab.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/chartab.c Mon Feb 08 06:42:16 2010 -0600
@@ -800,7 +800,7 @@
copy_mapper (struct chartab_range *range, Lisp_Object UNUSED (table),
Lisp_Object val, void *arg)
{
- put_char_table (VOID_TO_LISP (arg), range, val);
+ put_char_table (GET_LISP_FROM_VOID (arg), range, val);
return 0;
}
@@ -808,7 +808,7 @@
copy_char_table_range (Lisp_Object from, Lisp_Object to,
struct chartab_range *range)
{
- map_char_table (from, range, copy_mapper, LISP_TO_VOID (to));
+ map_char_table (from, range, copy_mapper, STORE_LISP_IN_VOID (to));
}
static Lisp_Object
diff -r f68b2ec914e3 -r ae48681c47fa src/console.c
--- a/src/console.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/console.c Mon Feb 08 06:42:16 2010 -0600
@@ -651,7 +651,7 @@
{
Lisp_Object console;
- console = VOID_TO_LISP (closure);
+ console = GET_LISP_FROM_VOID (closure);
if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
return 0;
if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
@@ -663,7 +663,7 @@
find_nonminibuffer_frame_not_on_console (Lisp_Object console)
{
return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate,
- LISP_TO_VOID (console));
+ STORE_LISP_IN_VOID (console));
}
static void
diff -r f68b2ec914e3 -r ae48681c47fa src/device.c
--- a/src/device.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/device.c Mon Feb 08 06:42:16 2010 -0600
@@ -752,7 +752,7 @@
{
Lisp_Object device;
- device = VOID_TO_LISP (closure);
+ device = GET_LISP_FROM_VOID (closure);
if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
return 0;
if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
@@ -764,7 +764,7 @@
find_nonminibuffer_frame_not_on_device (Lisp_Object device)
{
return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
- LISP_TO_VOID (device));
+ STORE_LISP_IN_VOID (device));
}
diff -r f68b2ec914e3 -r ae48681c47fa src/dialog-msw.c
--- a/src/dialog-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/dialog-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -203,7 +203,7 @@
case WM_DESTROY:
{
Lisp_Object data;
- data = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, DWL_USER));
+ data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER));
Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
}
break;
@@ -213,7 +213,7 @@
Lisp_Object fn, arg, data;
struct mswindows_dialog_id *did;
- data = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, DWL_USER));
+ data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER));
did = XMSWINDOWS_DIALOG_ID (data);
if (w_param != IDCANCEL) /* user pressed escape */
{
@@ -767,7 +767,7 @@
qxeCreateDialogIndirectParam (NULL,
(LPDLGTEMPLATE) Dynarr_begin (template_),
FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
- (LPARAM) LISP_TO_VOID (dialog_data));
+ (LPARAM) STORE_LISP_IN_VOID (dialog_data));
if (!did->hwnd)
/* Something went wrong creating the dialog */
signal_error (Qdialog_box_error, "Creating dialog", keys);
diff -r f68b2ec914e3 -r ae48681c47fa src/dialog-x.c
--- a/src/dialog-x.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/dialog-x.c Mon Feb 08 06:42:16 2010 -0600
@@ -51,12 +51,12 @@
{
Lisp_Object text_field_callback;
Extbyte *text_field_value = wv->value;
- text_field_callback = VOID_TO_LISP (wv->call_data);
+ text_field_callback = GET_LISP_FROM_VOID (wv->call_data);
text_field_callback = XCAR (XCDR (text_field_callback));
if (text_field_value)
{
void *tmp =
- LISP_TO_VOID (cons3 (Qnil,
+ STORE_LISP_IN_VOID (cons3 (Qnil,
list2 (text_field_callback,
build_extstring (text_field_value,
Qlwlib_encoding)),
diff -r f68b2ec914e3 -r ae48681c47fa src/eval.c
--- a/src/eval.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/eval.c Mon Feb 08 06:42:16 2010 -0600
@@ -6341,7 +6341,7 @@
static Lisp_Object
safe_run_hook_trapping_problems_1 (void *puta)
{
- Lisp_Object hook = VOID_TO_LISP (puta);
+ Lisp_Object hook = GET_LISP_FROM_VOID (puta);
run_hook (hook);
return Qnil;
@@ -6369,7 +6369,7 @@
flags | POSTPONE_WARNING_ISSUE,
&prob,
safe_run_hook_trapping_problems_1,
- LISP_TO_VOID (hook_symbol));
+ STORE_LISP_IN_VOID (hook_symbol));
{
Lisp_Object hook_name = XSYMBOL_NAME (hook_symbol);
Ibyte *hook_str = XSTRING_DATA (hook_name);
@@ -6701,10 +6701,9 @@
static Lisp_Object
restore_lisp_object (Lisp_Object cons)
{
- Lisp_Object opaque = XCAR (cons);
- Lisp_Object *addr = (Lisp_Object *) get_opaque_ptr (opaque);
+ Lisp_Object laddr = XCAR (cons);
+ Lisp_Object *addr = (Lisp_Object *) GET_VOID_FROM_LISP (laddr);
*addr = XCDR (cons);
- free_opaque_ptr (opaque);
free_cons (cons);
return Qnil;
}
@@ -6715,9 +6714,11 @@
record_unwind_protect_restoring_lisp_object (Lisp_Object *addr,
Lisp_Object val)
{
- Lisp_Object opaque = make_opaque_ptr (addr);
+ /* We use a cons rather than a malloc()ed structure because we want the
+ Lisp object to have garbage-collection protection */
+ Lisp_Object laddr = STORE_VOID_IN_LISP (addr);
return record_unwind_protect (restore_lisp_object,
- noseeum_cons (opaque, val));
+ noseeum_cons (laddr, val));
}
/* Similar to specbind() but for any C variable whose value is a
@@ -6734,35 +6735,18 @@
return count;
}
-static Lisp_Object
-restore_int (Lisp_Object cons)
-{
- Lisp_Object opaque = XCAR (cons);
- Lisp_Object lval = XCDR (cons);
- int *addr = (int *) get_opaque_ptr (opaque);
+struct restore_int
+{
+ int *addr;
int val;
-
- /* In the event that a C integer will always fit in an Emacs int, we
- haven't ever stored a C integer as an opaque pointer. This #ifdef
- eliminates a warning on AMD 64, where EMACS_INT has 63 value bits and C
- integers have 32 value bits. */
-#if INT_VALBITS < INTBITS
- if (INTP (lval))
- {
- val = XINT (lval);
- }
- else
- {
- val = (int) get_opaque_ptr (lval);
- free_opaque_ptr (lval);
- }
-#else /* !(INT_VALBITS < INTBITS) */
- val = XINT(lval);
-#endif /* INT_VALBITS < INTBITS */
-
- *addr = val;
- free_opaque_ptr (opaque);
- free_cons (cons);
+};
+
+static Lisp_Object
+restore_int (Lisp_Object obj)
+{
+ struct restore_int *ri = (struct restore_int *) GET_VOID_FROM_LISP (obj);
+ *(ri->addr) = ri->val;
+ xfree (ri);
return Qnil;
}
@@ -6772,23 +6756,10 @@
int
record_unwind_protect_restoring_int (int *addr, int val)
{
- Lisp_Object opaque = make_opaque_ptr (addr);
- Lisp_Object lval;
-
- /* In the event that a C integer will always fit in an Emacs int, we don't
- ever want to store a C integer as an opaque pointer. This #ifdef
- eliminates a warning on AMD 64, where EMACS_INT has 63 value bits and C
- integers have 32 value bits. */
-#if INT_VALBITS <= INTBITS
- if (NUMBER_FITS_IN_AN_EMACS_INT (val))
- lval = make_int (val);
- else
- lval = make_opaque_ptr ((void *) val);
-#else /* !(INT_VALBITS < INTBITS) */
- lval = make_int (val);
-#endif /* INT_VALBITS <= INTBITS */
-
- return record_unwind_protect (restore_int, noseeum_cons (opaque, lval));
+ struct restore_int *ri = xnew (struct restore_int);
+ ri->addr = addr;
+ ri->val = val;
+ return record_unwind_protect (restore_int, STORE_VOID_IN_LISP (ri));
}
/* Similar to specbind() but for any C variable whose value is an int.
@@ -6809,8 +6780,8 @@
static Lisp_Object
free_pointer (Lisp_Object opaque)
{
- xfree (get_opaque_ptr (opaque));
- free_opaque_ptr (opaque);
+ void *ptr = GET_VOID_FROM_LISP (opaque);
+ xfree (ptr);
return Qnil;
}
@@ -6819,23 +6790,20 @@
int
record_unwind_protect_freeing (void *ptr)
{
- Lisp_Object opaque = make_opaque_ptr (ptr);
- return record_unwind_protect (free_pointer, opaque);
+ return record_unwind_protect (free_pointer, STORE_VOID_IN_LISP (ptr));
}
static Lisp_Object
free_dynarr (Lisp_Object opaque)
{
- Dynarr_free (get_opaque_ptr (opaque));
- free_opaque_ptr (opaque);
+ Dynarr_free (GET_VOID_FROM_LISP (opaque));
return Qnil;
}
int
record_unwind_protect_freeing_dynarr (void *ptr)
{
- Lisp_Object opaque = make_opaque_ptr (ptr);
- return record_unwind_protect (free_dynarr, opaque);
+ return record_unwind_protect (free_dynarr, STORE_VOID_IN_LISP (ptr));
}
/* Unwind the stack till specpdl_depth() == COUNT.
diff -r f68b2ec914e3 -r ae48681c47fa src/event-msw.c
--- a/src/event-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/event-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -3629,7 +3629,7 @@
if (ii)
{
Lisp_Object image_instance;
- image_instance = VOID_TO_LISP ((void *) ii);
+ image_instance = GET_LISP_FROM_VOID ((void *) ii);
if (IMAGE_INSTANCEP (image_instance)
&&
IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET))
@@ -4155,7 +4155,7 @@
assert (!NILP (Vmswindows_frame_being_created));
return Vmswindows_frame_being_created;
}
- f = VOID_TO_LISP ((void *) l);
+ f = GET_LISP_FROM_VOID ((void *) l);
return f;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/faces.c
--- a/src/faces.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/faces.c Mon Feb 08 06:42:16 2010 -0600
@@ -527,8 +527,8 @@
struct face_inheritance_closure *fcl =
(struct face_inheritance_closure *) face_inheritance_closure;
- key = VOID_TO_LISP (hash_key);
- contents = VOID_TO_LISP (hash_contents);
+ key = GET_LISP_FROM_VOID (hash_key);
+ contents = GET_LISP_FROM_VOID (hash_contents);
if (EQ (fcl->property, Qfont))
{
diff -r f68b2ec914e3 -r ae48681c47fa src/frame-msw.c
--- a/src/frame-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/frame-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -276,7 +276,7 @@
FRAME_MSWINDOWS_HANDLE (f) = hwnd;
- qxeSetWindowLong (hwnd, XWL_FRAMEOBJ, (LONG)LISP_TO_VOID (frame_obj));
+ qxeSetWindowLong (hwnd, XWL_FRAMEOBJ, (LONG)STORE_LISP_IN_VOID (frame_obj));
FRAME_MSWINDOWS_DC (f) = GetDC (hwnd);
SetTextAlign (FRAME_MSWINDOWS_DC (f), TA_BASELINE | TA_LEFT | TA_NOUPDATECP);
@@ -556,7 +556,7 @@
/* Yippie! */
ScreenToClient (hwnd, &pt);
- *frame = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ));
+ *frame = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ));
*x = pt.x;
*y = pt.y;
return 1;
@@ -824,7 +824,7 @@
if (hwnd)
{
Lisp_Object parent;
- parent = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ));
+ parent = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ));
assert (FRAME_MSWINDOWS_P (XFRAME (parent)));
return parent;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/glade.c
--- a/src/glade.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/glade.c Mon Feb 08 06:42:16 2010 -0600
@@ -48,7 +48,7 @@
Lisp_Object func;
Lisp_Object lisp_data = Qnil;
- func = VOID_TO_LISP (user_data);
+ func = GET_LISP_FROM_VOID (user_data);
if (NILP (func))
{
@@ -97,7 +97,7 @@
glade_xml_signal_connect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
(char*) XSTRING_DATA (handler_name),
- connector, LISP_TO_VOID (func));
+ connector, STORE_LISP_IN_VOID (func));
return (Qt);
}
@@ -109,7 +109,7 @@
CHECK_GTK_OBJECT (xml);
glade_xml_signal_autoconnect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
- connector, LISP_TO_VOID (Qnil));
+ connector, STORE_LISP_IN_VOID (Qnil));
return (Qt);
}
diff -r f68b2ec914e3 -r ae48681c47fa src/glyphs-msw.c
--- a/src/glyphs-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/glyphs-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -2140,7 +2140,7 @@
GWL_HINSTANCE),
NULL);
- qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance));
+ qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)STORE_LISP_IN_VOID(image_instance));
IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd;
}
@@ -2288,7 +2288,7 @@
make_int (GetLastError()));
IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd;
- qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance));
+ qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)STORE_LISP_IN_VOID(image_instance));
/* set the widget font from the widget face */
if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
qxeSendMessage (wnd, WM_SETFONT,
diff -r f68b2ec914e3 -r ae48681c47fa src/glyphs.c
--- a/src/glyphs.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/glyphs.c Mon Feb 08 06:42:16 2010 -0600
@@ -660,7 +660,7 @@
if (!NILP (value))
{
Lisp_Object window;
- window = VOID_TO_LISP (flag_closure);
+ window = GET_LISP_FROM_VOID (flag_closure);
assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window));
}
@@ -676,7 +676,7 @@
assert (!NILP (w->subwindow_instance_cache));
elisp_maphash (check_instance_cache_mapper,
w->subwindow_instance_cache,
- LISP_TO_VOID (window));
+ STORE_LISP_IN_VOID (window));
}
void
diff -r f68b2ec914e3 -r ae48681c47fa src/gui-x.c
--- a/src/gui-x.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/gui-x.c Mon Feb 08 06:42:16 2010 -0600
@@ -81,9 +81,9 @@
struct widget_value_mapper *z = (struct widget_value_mapper *) closure;
if (val->call_data)
- z->protect_me = Fcons (VOID_TO_LISP (val->call_data), z->protect_me);
+ z->protect_me = Fcons (GET_LISP_FROM_VOID (val->call_data), z->protect_me);
if (val->accel)
- z->protect_me = Fcons (VOID_TO_LISP (val->accel), z->protect_me);
+ z->protect_me = Fcons (GET_LISP_FROM_VOID (val->accel), z->protect_me);
return 0;
}
@@ -243,7 +243,7 @@
return;
if (((EMACS_INT) client_data) == 0)
return;
- data = VOID_TO_LISP (client_data);
+ data = GET_LISP_FROM_VOID (client_data);
frame = wrap_frame (f);
#if 0
@@ -440,12 +440,12 @@
if (accel_p)
{
wv->name = add_accel_and_to_external (pgui->name);
- wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
+ wv->accel = STORE_LISP_IN_VOID (gui_item_accelerator (gui_item));
}
else
{
wv->name = LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, Qlwlib_encoding);
- wv->accel = LISP_TO_VOID (Qnil);
+ wv->accel = STORE_LISP_IN_VOID (Qnil);
}
if (!NILP (pgui->suffix))
@@ -468,7 +468,7 @@
wv_set_evalable_slot (wv->selected, pgui->selected);
if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
- wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
+ wv->call_data = STORE_LISP_IN_VOID (cons3 (gui_object_instance,
pgui->callback,
pgui->callback_ex));
diff -r f68b2ec914e3 -r ae48681c47fa src/keymap.c
--- a/src/keymap.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/keymap.c Mon Feb 08 06:42:16 2010 -0600
@@ -3022,7 +3022,7 @@
{
/* This function can GC */
Lisp_Object fn;
- fn = VOID_TO_LISP (function);
+ fn = GET_LISP_FROM_VOID (function);
call2 (fn, make_key_description (key, 1), binding);
}
@@ -3082,7 +3082,7 @@
GCPRO2 (function, keymap);
keymap = get_keymap (keymap, 1, 1);
map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
- map_keymap_mapper, LISP_TO_VOID (function));
+ map_keymap_mapper, STORE_LISP_IN_VOID (function));
UNGCPRO;
return Qnil;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/lisp-disunion.h
--- a/src/lisp-disunion.h Mon Feb 08 04:47:56 2010 -0600
+++ b/src/lisp-disunion.h Mon Feb 08 06:42:16 2010 -0600
@@ -114,15 +114,17 @@
/* WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- You can only VOID_TO_LISP something that had previously been
- LISP_TO_VOID'd. You cannot go the other way, i.e. create a bogus
- Lisp_Object. If you want to stuff a void * into a Lisp_Object, use
- make_opaque_ptr(). */
+ You can only GET_LISP_FROM_VOID something that had previously been
+ STORE_LISP_IN_VOID'd. If you want to go the other way, use
+ STORE_VOID_IN_LISP and GET_VOID_FROM_LISP, or use make_opaque_ptr(). */
-/* Convert between a (void *) and a Lisp_Object, as when the
- Lisp_Object is passed to a toolkit callback function */
-#define VOID_TO_LISP(varg) ((Lisp_Object) (varg))
-#define LISP_TO_VOID(larg) ((void *) (larg))
+/* Convert a Lisp object to a void * pointer, as when it needs to be passed
+ to a toolkit callback function */
+#define STORE_LISP_IN_VOID(larg) ((void *) (larg))
+
+/* Convert a void * pointer back into a Lisp object, assuming that the
+ pointer was generated by STORE_LISP_IN_VOID. */
+#define GET_LISP_FROM_VOID(varg) ((Lisp_Object) (varg))
/* Convert a Lisp_Object into something that can't be used as an
lvalue. Useful for type-checking. */
diff -r f68b2ec914e3 -r ae48681c47fa src/lisp-union.h
--- a/src/lisp-union.h Mon Feb 08 04:47:56 2010 -0600
+++ b/src/lisp-union.h Mon Feb 08 06:42:16 2010 -0600
@@ -1,7 +1,7 @@
/* Fundamental definitions for XEmacs Lisp interpreter -- union objects.
Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
Free Software Foundation, Inc.
- Copyright (C) 2002, 2005 Ben Wing.
+ Copyright (C) 2002, 2005, 2010 Ben Wing.
This file is part of XEmacs.
@@ -142,24 +142,25 @@
/* WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- You can only VOID_TO_LISP something that had previously been
- LISP_TO_VOID'd. You cannot go the other way, i.e. create a bogus
- Lisp_Object. If you want to stuff a void * into a Lisp_Object, use
- make_opaque_ptr(). */
+ You can only GET_LISP_FROM_VOID something that had previously been
+ STORE_LISP_IN_VOID'd. If you want to go the other way, use
+ STORE_VOID_IN_LISP and GET_VOID_FROM_LISP, or use make_opaque_ptr(). */
-/* Convert between a (void *) and a Lisp_Object, as when the
- Lisp_Object is passed to a toolkit callback function */
+/* Convert a Lisp object to a void * pointer, as when it needs to be passed
+ to a toolkit callback function */
+#define STORE_LISP_IN_VOID(larg) ((void *) ((larg).v))
+
+/* Convert a void * pointer back into a Lisp object, assuming that the
+ pointer was generated by STORE_LISP_IN_VOID. */
DECLARE_INLINE_HEADER (
Lisp_Object
-VOID_TO_LISP (const void *arg)
+GET_LISP_FROM_VOID (const void *arg)
)
{
Lisp_Object larg;
larg.v = (struct nosuchstruct *) arg;
return larg;
}
-
-#define LISP_TO_VOID(larg) ((void *) ((larg).v))
/* Convert a Lisp_Object into something that can't be used as an
lvalue. Useful for type-checking. */
diff -r f68b2ec914e3 -r ae48681c47fa src/lisp.h
--- a/src/lisp.h Mon Feb 08 04:47:56 2010 -0600
+++ b/src/lisp.h Mon Feb 08 06:42:16 2010 -0600
@@ -1699,6 +1699,44 @@
#include "lrecord.h"
+/* Turn any void * pointer into a Lisp object. This is the counterpart of
+ STORE_LISP_IN_VOID, which works in the opposite direction. Note that
+ you CANNOT use STORE_LISP_IN_VOID to undo the effects of STORE_VOID_IN_LISP!
+ Instead, you GET_VOID_FROM_LISP:
+
+ STORE_VOID_IN_LISP <--> GET_VOID_FROM_LISP vs.
+ STORE_LISP_IN_VOID <--> GET_LISP_FROM_VOID
+
+ STORE_VOID_IN_LISP has a restriction on the void * pointers it can
+ handle -- the pointer must be an even address (lowest bit set to 0).
+ Generally this is not a problem as nowadays virtually all allocation is
+ at least 4-byte aligned, if not 8-byte.
+
+ However, if this proves problematic, you can use make_opaque_ptr(), which
+ is guaranteed to handle any kind of void * pointer but which does
+ Lisp allocation.
+ */
+
+DECLARE_INLINE_HEADER (
+Lisp_Object
+STORE_VOID_IN_LISP (void *ptr)
+)
+{
+ EMACS_UINT p = (EMACS_UINT) ptr;
+
+ type_checking_assert ((p & 1) == 0);
+ return make_int (p >> 1);
+}
+
+DECLARE_INLINE_HEADER (
+void *
+GET_VOID_FROM_LISP (Lisp_Object obj)
+)
+{
+ EMACS_UINT p = XUINT (obj);
+ return (void *) (p << 1);
+}
+
/************************************************************************/
/** Definitions of dynamic arrays (Dynarrs) and other allocators **/
/************************************************************************/
@@ -3897,7 +3935,7 @@
#define HASH8(a,b,c,d,e,f,g,h) (GOOD_HASH * HASH7 (a,b,c,d,e,f,g) + (h))
#define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i))
-#define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj))
+#define LISP_HASH(obj) ((unsigned long) STORE_LISP_IN_VOID (obj))
Hashcode memory_hash (const void *xv, Bytecount size);
Hashcode internal_hash (Lisp_Object obj, int depth);
Hashcode internal_array_hash (Lisp_Object *arr, int size, int depth);
diff -r f68b2ec914e3 -r ae48681c47fa src/menubar-gtk.c
--- a/src/menubar-gtk.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/menubar-gtk.c Mon Feb 08 06:42:16 2010 -0600
@@ -320,7 +320,7 @@
Lisp_Object menu_desc = Qnil;
GtkWidget *old_submenu = GTK_MENU_ITEM (menu_item)->submenu;
- menu_desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG));
+ menu_desc = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG));
/* GCPRO all of our very own */
gcpro_popup_callbacks (id, menu_desc);
@@ -385,7 +385,7 @@
return;
}
- desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG));
+ desc = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG));
#ifdef TEAR_OFF_MENUS
/* Lets stick in a detacher just for giggles */
@@ -404,7 +404,7 @@
Lisp_Object hook_fn;
struct gcpro gcpro1, gcpro2;
- hook_fn = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG));
+ hook_fn = GET_LISP_FROM_VOID (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG));
GCPRO2 (desc, hook_fn);
@@ -646,7 +646,7 @@
#if 0
if ( SYMBOLP (val)
|| CHARP (val))
- wv->accel = LISP_TO_VOID (val);
+ wv->accel = STORE_LISP_IN_VOID (val);
else
invalid_argument ("bad keyboard accelerator", val);
#endif
@@ -659,8 +659,8 @@
invalid_argument ("unknown menu cascade keyword", cascade);
}
- gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG, LISP_TO_VOID (desc));
- gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FILTER_TAG, LISP_TO_VOID (hook_fn));
+ gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG, STORE_LISP_IN_VOID (desc));
+ gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FILTER_TAG, STORE_LISP_IN_VOID (hook_fn));
if ((!NILP (config_tag)
&& NILP (Fmemq (config_tag, Vmenubar_configuration)))
@@ -741,7 +741,7 @@
channel = wrap_frame (gtk_widget_to_frame (GTK_WIDGET (item)));
- callback = VOID_TO_LISP (user_data);
+ callback = GET_LISP_FROM_VOID (user_data);
get_gui_callback (callback, &function, &data);
@@ -1007,11 +1007,11 @@
gtk_signal_connect (GTK_OBJECT (widget), "activate-item",
GTK_SIGNAL_FUNC (__generic_button_callback),
- LISP_TO_VOID (callback));
+ STORE_LISP_IN_VOID (callback));
gtk_signal_connect (GTK_OBJECT (widget), "activate",
GTK_SIGNAL_FUNC (__generic_button_callback),
- LISP_TO_VOID (callback));
+ STORE_LISP_IN_VOID (callback));
/* Now that all the information about the menu item is know, set the
remaining properties.
diff -r f68b2ec914e3 -r ae48681c47fa src/menubar-msw.c
--- a/src/menubar-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/menubar-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -97,7 +97,7 @@
/* #### */
#define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0
-#define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
+#define EMPTY_ITEM_ID ((UINT)STORE_LISP_IN_VOID (Qunbound))
#define EMPTY_ITEM_NAME "(empty)" /* WARNING: uses of this need XETEXT */
/* Current menu (bar or popup) descriptor. gcpro'ed */
diff -r f68b2ec914e3 -r ae48681c47fa src/menubar-x.c
--- a/src/menubar-x.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/menubar-x.c Mon Feb 08 06:42:16 2010 -0600
@@ -128,7 +128,7 @@
manipulate the accel as a Lisp_Object if the widget has a name.
Since simple labels have a name, but no accel, we *must* set it
to nil */
- wv->accel = LISP_TO_VOID (Qnil);
+ wv->accel = STORE_LISP_IN_VOID (Qnil);
}
}
else if (VECTORP (desc))
@@ -162,7 +162,7 @@
wv->name = add_accel_and_to_external (XCAR (desc));
accel = gui_name_accelerator (XCAR (desc));
- wv->accel = LISP_TO_VOID (accel);
+ wv->accel = STORE_LISP_IN_VOID (accel);
desc = Fcdr (desc);
@@ -186,7 +186,7 @@
{
if ( SYMBOLP (val)
|| CHARP (val))
- wv->accel = LISP_TO_VOID (val);
+ wv->accel = STORE_LISP_IN_VOID (val);
else
invalid_argument ("bad keyboard accelerator", val);
}
@@ -231,7 +231,7 @@
/* This is automatically GC protected through
the call to lw_map_widget_values(); no need
to worry. */
- incr_wv->call_data = LISP_TO_VOID (incremental_data);
+ incr_wv->call_data = STORE_LISP_IN_VOID (incremental_data);
goto menu_item_done;
}
#endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
@@ -261,7 +261,7 @@
/* Add a fake entry so the menus show up */
wv->contents = dummy = xmalloc_widget_value ();
dummy->name = xstrdup ("(inactive)");
- dummy->accel = LISP_TO_VOID (Qnil);
+ dummy->accel = STORE_LISP_IN_VOID (Qnil);
dummy->enabled = 0;
dummy->selected = 0;
dummy->value = NULL;
@@ -471,7 +471,7 @@
widget_value *wv;
assert (hack_wv->type == INCREMENTAL_TYPE);
- submenu_desc = VOID_TO_LISP (hack_wv->call_data);
+ submenu_desc = GET_LISP_FROM_VOID (hack_wv->call_data);
wv = (protected_menu_item_descriptor_to_widget_value
(submenu_desc, SUBMENU_TYPE, 1, 0));
@@ -481,12 +481,12 @@
wv = xmalloc_widget_value ();
wv->type = CASCADE_TYPE;
wv->next = NULL;
- wv->accel = LISP_TO_VOID (Qnil);
+ wv->accel = STORE_LISP_IN_VOID (Qnil);
wv->contents = xmalloc_widget_value ();
wv->contents->type = TEXT_TYPE;
wv->contents->name = xstrdup ("No menu");
wv->contents->next = NULL;
- wv->contents->accel = LISP_TO_VOID (Qnil);
+ wv->contents->accel = STORE_LISP_IN_VOID (Qnil);
}
assert (wv && wv->type == CASCADE_TYPE && wv->contents);
replace_widget_value_tree (hack_wv, wv->contents);
@@ -1032,7 +1032,7 @@
while (entries)
{
Lisp_Object accel;
- accel = VOID_TO_LISP (entries->accel);
+ accel = GET_LISP_FROM_VOID (entries->accel);
if (entries->name && !NILP (accel))
{
if (event_matches_key_specifier_p (evee, accel))
@@ -1265,7 +1265,7 @@
while (val)
{
Lisp_Object accel;
- accel = VOID_TO_LISP (val->accel);
+ accel = GET_LISP_FROM_VOID (val->accel);
if (val->name && !NILP (accel))
{
Fsetcar (last, accel);
diff -r f68b2ec914e3 -r ae48681c47fa src/print.c
--- a/src/print.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/print.c Mon Feb 08 06:42:16 2010 -0600
@@ -1944,7 +1944,7 @@
{
/* We're in trouble if this happens! */
printing_major_badness (printcharfun, "ILLEGAL LISP OBJECT TAG TYPE",
- XTYPE (obj), LISP_TO_VOID (obj), 0,
+ XTYPE (obj), STORE_LISP_IN_VOID (obj), 0,
BADNESS_INTEGER_OBJECT);
break;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/process-unix.c
--- a/src/process-unix.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/process-unix.c Mon Feb 08 06:42:16 2010 -0600
@@ -126,7 +126,7 @@
close_process_descs_mapfun (const void *UNUSED (key), void *contents,
void *UNUSED (arg))
{
- Lisp_Object proc = VOID_TO_LISP (contents);
+ Lisp_Object proc = GET_LISP_FROM_VOID (contents);
USID vaffan, culo;
event_stream_delete_io_streams (XPROCESS (proc)->pipe_instream,
diff -r f68b2ec914e3 -r ae48681c47fa src/process.c
--- a/src/process.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/process.c Mon Feb 08 06:42:16 2010 -0600
@@ -232,7 +232,7 @@
if (gethash ((const void*)usid, usid_to_process, &vval))
{
Lisp_Object process;
- process = VOID_TO_LISP (vval);
+ process = GET_LISP_FROM_VOID (vval);
return XPROCESS (process);
}
else
@@ -560,14 +560,14 @@
{
Lisp_Object process = Qnil;
process = wrap_process (p);
- puthash ((const void*) in_usid, LISP_TO_VOID (process), usid_to_process);
+ puthash ((const void*) in_usid, STORE_LISP_IN_VOID (process), usid_to_process);
}
if (err_usid != USID_DONTHASH)
{
Lisp_Object process = Qnil;
process = wrap_process (p);
- puthash ((const void*) err_usid, LISP_TO_VOID (process),
+ puthash ((const void*) err_usid, STORE_LISP_IN_VOID (process),
usid_to_process);
}
diff -r f68b2ec914e3 -r ae48681c47fa src/profile.c
--- a/src/profile.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/profile.c Mon Feb 08 06:42:16 2010 -0600
@@ -315,13 +315,13 @@
long count;
const void *vval;
- if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
+ if (gethash (STORE_LISP_IN_VOID (fun), big_profile_table, &vval))
count = (long) vval;
else
count = 0;
count++;
vval = (const void *) count;
- puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
+ puthash (STORE_LISP_IN_VOID (fun), (void *) vval, big_profile_table);
}
profiling_lock = 0;
@@ -463,7 +463,7 @@
= (struct get_profiling_info_closure *) void_closure;
EMACS_INT val;
- key = VOID_TO_LISP (void_key);
+ key = GET_LISP_FROM_VOID (void_key);
val = (EMACS_INT) void_val;
Fputhash (key, make_int (val), closure->timing);
@@ -524,7 +524,7 @@
/* OK, OK ... the total-timing table is not going to have an entry
for profile overhead, and it looks strange for it to come out 0,
so make sure it looks reasonable. */
- if (!gethash (LISP_TO_VOID (QSprofile_overhead), big_profile_table,
+ if (!gethash (STORE_LISP_IN_VOID (QSprofile_overhead), big_profile_table,
&overhead))
overhead = 0;
Fputhash (QSprofile_overhead, make_int ((EMACS_INT) overhead),
@@ -557,7 +557,7 @@
("Function timing count is not an integer in given entry",
key, val);
- puthash (LISP_TO_VOID (key), (void *) XINT (val), big_profile_table);
+ puthash (STORE_LISP_IN_VOID (key), (void *) XINT (val), big_profile_table);
return 0;
}
@@ -609,9 +609,9 @@
void *UNUSED (void_closure))
{
#ifdef USE_KKCC
- kkcc_gc_stack_push_lisp_object (VOID_TO_LISP (void_key), 0, -1);
+ kkcc_gc_stack_push_lisp_object (GET_LISP_FROM_VOID (void_key), 0, -1);
#else /* NOT USE_KKCC */
- mark_object (VOID_TO_LISP (void_key));
+ mark_object (GET_LISP_FROM_VOID (void_key));
#endif /* NOT USE_KKCC */
return 0;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/scrollbar-msw.c
--- a/src/scrollbar-msw.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/scrollbar-msw.c Mon Feb 08 06:42:16 2010 -0600
@@ -84,7 +84,7 @@
Fputhash (ptr, wrap_scrollbar_instance (sb),
Vmswindows_scrollbar_instance_table);
qxeSetWindowLong (SCROLLBAR_MSW_HANDLE (sb), GWL_USERDATA,
- (LONG) LISP_TO_VOID (ptr));
+ (LONG) STORE_LISP_IN_VOID (ptr));
}
static void
@@ -96,7 +96,7 @@
(void *) qxeGetWindowLong (SCROLLBAR_MSW_HANDLE (sb), GWL_USERDATA);
Lisp_Object ptr;
- ptr = VOID_TO_LISP (opaque);
+ ptr = GET_LISP_FROM_VOID (opaque);
assert (OPAQUE_PTRP (ptr));
ptr = Fremhash (ptr, Vmswindows_scrollbar_instance_table);
assert (!NILP (ptr));
@@ -223,7 +223,7 @@
else
{
Lisp_Object ptr;
- ptr = VOID_TO_LISP (v);
+ ptr = GET_LISP_FROM_VOID (v);
assert (OPAQUE_PTRP (ptr));
ptr = Fgethash (ptr, Vmswindows_scrollbar_instance_table, Qnil);
sb = XSCROLLBAR_INSTANCE (ptr);
diff -r f68b2ec914e3 -r ae48681c47fa src/specifier.c
--- a/src/specifier.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/specifier.c Mon Feb 08 06:42:16 2010 -0600
@@ -3548,7 +3548,7 @@
{
Lisp_Object specifier = Qnil;
- specifier = VOID_TO_LISP (closure);
+ specifier = GET_LISP_FROM_VOID (closure);
recompute_one_cached_specifier_in_window (specifier, w);
return 0;
}
@@ -3568,7 +3568,7 @@
FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
map_windows (XFRAME (XCAR (frmcons)),
recompute_cached_specifier_everywhere_mapfun,
- LISP_TO_VOID (specifier));
+ STORE_LISP_IN_VOID (specifier));
}
if (XSPECIFIER (specifier)->caching->offset_into_struct_frame)
diff -r f68b2ec914e3 -r ae48681c47fa src/syntax.c
--- a/src/syntax.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/syntax.c Mon Feb 08 06:42:16 2010 -0600
@@ -2298,7 +2298,7 @@
copy_to_mirrortab (struct chartab_range *range, Lisp_Object UNUSED (table),
Lisp_Object val, void *arg)
{
- Lisp_Object mirrortab = VOID_TO_LISP (arg);
+ Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg);
if (CONSP (val))
val = XCAR (val);
@@ -2312,7 +2312,7 @@
Lisp_Object UNUSED (table),
Lisp_Object val, void *arg)
{
- Lisp_Object mirrortab = VOID_TO_LISP (arg);
+ Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg);
if (CONSP (val))
val = XCAR (val);
if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit)
@@ -2357,12 +2357,12 @@
another mapping.)
*/
- map_char_table (table, &range, copy_to_mirrortab, LISP_TO_VOID (mirrortab));
+ map_char_table (table, &range, copy_to_mirrortab, STORE_LISP_IN_VOID (mirrortab));
/* second clause catches bootstrapping problems when initializing the
standard syntax table */
if (!EQ (table, Vstandard_syntax_table) && !NILP (Vstandard_syntax_table))
map_char_table (Vstandard_syntax_table, &range,
- copy_if_not_already_present, LISP_TO_VOID (mirrortab));
+ copy_if_not_already_present, STORE_LISP_IN_VOID (mirrortab));
/* The resetting made the default be Qnil. Put it back to Sword. */
set_char_table_default (mirrortab, make_int (Sword));
XCHAR_TABLE (mirrortab)->dirty = 0;
diff -r f68b2ec914e3 -r ae48681c47fa src/tests.c
--- a/src/tests.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/tests.c Mon Feb 08 06:42:16 2010 -0600
@@ -1,6 +1,6 @@
/* C support for testing XEmacs - see tests/automated/c-tests.el
Copyright (C) 2000 Martin Buchholz
- Copyright (C) 2001, 2002 Ben Wing.
+ Copyright (C) 2001, 2002, 2010 Ben Wing.
Copyright (C) 2006 The Free Software Foundation, Inc.
This file is part of XEmacs.
@@ -645,6 +645,46 @@
return hash_result;
}
+DEFUN ("test-store-void-in-lisp", Ftest_store_void_in_lisp, 0, 0, "", /*
+ Test STORE_VOID_IN_LISP and its inverse GET_VOID_FROM_LISP.
+Tests by internal assert(); only returns if it succeeds.
+*/
+ ())
+{
+ struct foobar { int x; int y; short z; void *q; } baz;
+
+#define FROB(val) \
+do \
+{ \
+ void *pval = (void *) (val); \
+ assert (GET_VOID_FROM_LISP (STORE_VOID_IN_LISP (pval)) == pval); \
+} \
+while (0)
+ assert (INT_VALBITS >= 31);
+ FROB (&baz);
+ FROB (&baz.x);
+ FROB (&baz.y);
+ FROB (&baz.z);
+ FROB (&baz.q);
+ FROB (0);
+ FROB (2);
+ FROB (&Vtest_function_list);
+ FROB (0x00000080);
+ FROB (0x00008080);
+ FROB (0x00808080);
+ FROB (0x80808080);
+ FROB (0xCAFEBABE);
+ FROB (0xFFFFFFFE);
+#if INT_VALBITS >= 63
+ FROB (0x0000808080808080);
+ FROB (0x8080808080808080);
+ FROB (0XDEADBEEFCAFEBABE);
+ FROB (0XFFFFFFFFFFFFFFFE);
+#endif /* INT_VALBITS >= 63 */
+
+ return list3 (build_ascstring ("STORE_VOID_IN_LISP"), Qt, Qnil);
+}
+
#ifdef NEW_GC
@@ -671,6 +711,7 @@
TESTS_DEFSUBR (Ftest_data_format_conversion);
TESTS_DEFSUBR (Ftest_hash_tables);
+ TESTS_DEFSUBR (Ftest_store_void_in_lisp);
/* Add other test functions here with TESTS_DEFSUBR */
}
diff -r f68b2ec914e3 -r ae48681c47fa src/text.c
--- a/src/text.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/text.c Mon Feb 08 06:42:16 2010 -0600
@@ -4571,7 +4571,7 @@
break;
case DFC_LISP_STRING:
- TO_EXTERNAL_FORMAT (LISP_STRING, VOID_TO_LISP (src),
+ TO_EXTERNAL_FORMAT (LISP_STRING, GET_LISP_FROM_VOID (src),
MALLOC, (*dst, *dst_size), codesys);
break;
diff -r f68b2ec914e3 -r ae48681c47fa src/text.h
--- a/src/text.h Mon Feb 08 04:47:56 2010 -0600
+++ b/src/text.h Mon Feb 08 06:42:16 2010 -0600
@@ -2869,10 +2869,10 @@
#define ITEXT_TO_EXTERNAL_MALLOC(src, codesys) \
((Extbyte *) new_dfc_convert_malloc (src, -1, DFC_INTERNAL, codesys))
#define LISP_STRING_TO_EXTERNAL(src, codesys) \
- ((Extbyte *) NEW_DFC_CONVERT_1_ALLOCA (LISP_TO_VOID (src), -1, \
+ ((Extbyte *) NEW_DFC_CONVERT_1_ALLOCA (STORE_LISP_IN_VOID (src), -1, \
DFC_LISP_STRING, codesys))
#define LISP_STRING_TO_EXTERNAL_MALLOC(src, codesys) \
- ((Extbyte *) new_dfc_convert_malloc (LISP_TO_VOID (src), -1, \
+ ((Extbyte *) new_dfc_convert_malloc (STORE_LISP_IN_VOID (src), -1, \
DFC_LISP_STRING, codesys))
/* In place of EXTERNAL_TO_LISP_STRING(), use build_extstring() and/or
make_extstring(). */
diff -r f68b2ec914e3 -r ae48681c47fa src/tooltalk.c
--- a/src/tooltalk.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/tooltalk.c Mon Feb 08 06:42:16 2010 -0600
@@ -360,7 +360,7 @@
fflush (tooltalk_log_file);
#endif
- message_ = VOID_TO_LISP (tt_message_user (m, TOOLTALK_MESSAGE_KEY));
+ message_ = GET_LISP_FROM_VOID (tt_message_user (m, TOOLTALK_MESSAGE_KEY));
pattern = make_tooltalk_pattern (p);
cb = XTOOLTALK_MESSAGE (message_)->callback;
GCPRO2 (message_, pattern);
@@ -404,7 +404,7 @@
#endif
message_ = make_tooltalk_message (m);
- pattern = VOID_TO_LISP (tt_pattern_user (p, TOOLTALK_PATTERN_KEY));
+ pattern = GET_LISP_FROM_VOID (tt_pattern_user (p, TOOLTALK_PATTERN_KEY));
cb = XTOOLTALK_PATTERN (pattern)->callback;
GCPRO2 (message_, pattern);
if (!NILP (Vtooltalk_pattern_handler_hook))
@@ -864,7 +864,7 @@
tt_message_callback_add (m, tooltalk_message_callback);
}
tt_message_session_set (m, tt_default_session ());
- tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, LISP_TO_VOID (message_));
+ tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, STORE_LISP_IN_VOID (message_));
return message_;
}
@@ -972,7 +972,7 @@
tt_pattern_callback_add (p, tooltalk_pattern_callback);
tt_pattern_session_add (p, tt_default_session ());
- tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, LISP_TO_VOID (pattern));
+ tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, STORE_LISP_IN_VOID (pattern));
return pattern;
}
diff -r f68b2ec914e3 -r ae48681c47fa src/ui-byhand.c
--- a/src/ui-byhand.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/ui-byhand.c Mon Feb 08 06:42:16 2010 -0600
@@ -490,7 +490,7 @@
Lisp_Object callback;
Lisp_Object lisp_user_data;
- callback = VOID_TO_LISP (user_data);
+ callback = GET_LISP_FROM_VOID (user_data);
lisp_user_data = XCAR (callback);
callback = XCDR (callback);
@@ -549,7 +549,7 @@
(char*) XSTRING_DATA (tooltip_private_text),
GTK_WIDGET (XGTK_OBJECT (icon)->object),
GTK_SIGNAL_FUNC (__generic_toolbar_callback),
- LISP_TO_VOID (callback));
+ STORE_LISP_IN_VOID (callback));
}
else
{
@@ -559,7 +559,7 @@
(char*) XSTRING_DATA (tooltip_private_text),
GTK_WIDGET (XGTK_OBJECT (icon)->object),
GTK_SIGNAL_FUNC (__generic_toolbar_callback),
- LISP_TO_VOID (callback),
+ STORE_LISP_IN_VOID (callback),
XINT (position));
}
@@ -599,7 +599,7 @@
{
Lisp_Object closure;
- closure = VOID_TO_LISP (user_data);
+ closure = GET_LISP_FROM_VOID (user_data);
call3 (XCAR (closure),
build_gtk_object (GTK_OBJECT (ctree)),
@@ -666,7 +666,7 @@
(GTK_CTREE (XGTK_OBJECT (ctree)->object),
NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
__emacs_gtk_ctree_recurse_internal,
- LISP_TO_VOID (closure));
+ STORE_LISP_IN_VOID (closure));
}
else
{
@@ -675,7 +675,7 @@
NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
XINT (depth),
__emacs_gtk_ctree_recurse_internal,
- LISP_TO_VOID (closure));
+ STORE_LISP_IN_VOID (closure));
}
UNGCPRO;
diff -r f68b2ec914e3 -r ae48681c47fa src/ui-gtk.c
--- a/src/ui-gtk.c Mon Feb 08 04:47:56 2010 -0600
+++ b/src/ui-gtk.c Mon Feb 08 06:42:16 2010 -0600
@@ -1016,7 +1016,7 @@
{
Lisp_Object lisp_data;
- lisp_data = VOID_TO_LISP (data);
+ lisp_data = GET_LISP_FROM_VOID (data);
ungcpro_popup_callbacks (XINT (XCAR (lisp_data)));
}
@@ -1032,7 +1032,7 @@
struct gcpro gcpro1;
int i;
- callback_fn = VOID_TO_LISP (data);
+ callback_fn = GET_LISP_FROM_VOID (data);
/* Nuke the GUI_ID off the front */
callback_fn = XCDR (callback_fn);
@@ -1098,7 +1098,7 @@
gcpro_popup_callbacks (id, func);
gtk_signal_connect_full (XGTK_OBJECT (obj)->object, (char *) XSTRING_DATA (name),
- NULL, __internal_callback_marshal, LISP_TO_VOID (func),
+ NULL, __internal_callback_marshal, STORE_LISP_IN_VOID (func),
__internal_callback_destroy, c_object_signal, c_after);
return (Qt);
}
@@ -1516,7 +1516,7 @@
{
Lisp_Object rval;
- rval = VOID_TO_LISP (GTK_VALUE_POINTER (*arg));
+ rval = GET_LISP_FROM_VOID (GTK_VALUE_POINTER (*arg));
return (rval);
}
else
@@ -1531,7 +1531,7 @@
{
Lisp_Object rval;
- rval = VOID_TO_LISP (GTK_VALUE_CALLBACK (*arg).data);
+ rval = GET_LISP_FROM_VOID (GTK_VALUE_CALLBACK (*arg).data);
return (rval);
}
@@ -1752,7 +1752,7 @@
if (NILP (obj))
GTK_VALUE_POINTER(*arg) = NULL;
else
- GTK_VALUE_POINTER(*arg) = LISP_TO_VOID (obj);
+ GTK_VALUE_POINTER(*arg) = STORE_LISP_IN_VOID (obj);
break;
/* structured types */
@@ -2032,7 +2032,7 @@
if (NILP (obj))
*(GTK_RETLOC_POINTER(*arg)) = NULL;
else
- *(GTK_RETLOC_POINTER(*arg)) = LISP_TO_VOID (obj);
+ *(GTK_RETLOC_POINTER(*arg)) = STORE_LISP_IN_VOID (obj);
break;
/* structured types */
More information about the XEmacs-Patches
mailing list