Mercurial > hg > xemacs-beta
changeset 5013:ae48681c47fa
changes to VOID_TO_LISP et al.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben@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.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 08 Feb 2010 06:42:16 -0600 |
| parents | f68b2ec914e3 |
| children | c2e0c3af5fe3 |
| 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 |
| diffstat | 35 files changed, 367 insertions(+), 185 deletions(-) [+] |
line wrap: on
line diff
--- 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@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@xemacs.org> * fns.c: Qlist, Qstring mistakenly declared twice.
--- 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);
--- 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
--- 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
--- 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)); }
--- 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);
--- 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)),
--- 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.
--- 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; }
--- 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)) {
--- 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; }
--- 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); }
--- 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,
--- 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
--- 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));
--- 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; }
--- 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. */
--- 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,16 +142,19 @@ /* 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; @@ -159,8 +162,6 @@ 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. */ #if (__GNUC__ > 1)
--- 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);
--- 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.
--- 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 */
--- 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);
--- 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; }
--- 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,
--- 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); }
--- 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; }
--- 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);
--- 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)
--- 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;
--- 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 */ }
--- 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;
--- 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(). */
--- 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; }
--- 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;
--- 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 */