Mercurial > hg > xemacs-beta

comparison src/eval.c @ 5013:ae48681c47fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 3c3c1d139863
children 2ade80e8c640
comparison
equal deleted inserted replaced
5012:f68b2ec914e3 5013:ae48681c47fa
6339 } 6339 }
6340 6340
6341 static Lisp_Object 6341 static Lisp_Object
6342 safe_run_hook_trapping_problems_1 (void *puta) 6342 safe_run_hook_trapping_problems_1 (void *puta)
6343 { 6343 {
6344 Lisp_Object hook = VOID_TO_LISP (puta); 6344 Lisp_Object hook = GET_LISP_FROM_VOID (puta);
6345 6345
6346 run_hook (hook); 6346 run_hook (hook);
6347 return Qnil; 6347 return Qnil;
6348 } 6348 }
6349 6349
6367 GCPRO2 (hook_symbol, tem); 6367 GCPRO2 (hook_symbol, tem);
6368 tem = call_trapping_problems (Qerror, NULL, 6368 tem = call_trapping_problems (Qerror, NULL,
6369 flags | POSTPONE_WARNING_ISSUE, 6369 flags | POSTPONE_WARNING_ISSUE,
6370 &prob, 6370 &prob,
6371 safe_run_hook_trapping_problems_1, 6371 safe_run_hook_trapping_problems_1,
6372 LISP_TO_VOID (hook_symbol)); 6372 STORE_LISP_IN_VOID (hook_symbol));
6373 { 6373 {
6374 Lisp_Object hook_name = XSYMBOL_NAME (hook_symbol); 6374 Lisp_Object hook_name = XSYMBOL_NAME (hook_symbol);
6375 Ibyte *hook_str = XSTRING_DATA (hook_name); 6375 Ibyte *hook_str = XSTRING_DATA (hook_name);
6376 Ibyte *err = alloca_ibytes (XSTRING_LENGTH (hook_name) + 100); 6376 Ibyte *err = alloca_ibytes (XSTRING_LENGTH (hook_name) + 100);
6377 6377
6699 } 6699 }
6700 6700
6701 static Lisp_Object 6701 static Lisp_Object
6702 restore_lisp_object (Lisp_Object cons) 6702 restore_lisp_object (Lisp_Object cons)
6703 { 6703 {
6704 Lisp_Object opaque = XCAR (cons); 6704 Lisp_Object laddr = XCAR (cons);
6705 Lisp_Object *addr = (Lisp_Object *) get_opaque_ptr (opaque); 6705 Lisp_Object *addr = (Lisp_Object *) GET_VOID_FROM_LISP (laddr);
6706 *addr = XCDR (cons); 6706 *addr = XCDR (cons);
6707 free_opaque_ptr (opaque);
6708 free_cons (cons); 6707 free_cons (cons);
6709 return Qnil; 6708 return Qnil;
6710 } 6709 }
6711 6710
6712 /* Establish an unwind-protect which will restore the Lisp_Object pointed to 6711 /* Establish an unwind-protect which will restore the Lisp_Object pointed to
6713 by ADDR with the value VAL. */ 6712 by ADDR with the value VAL. */
6714 static int 6713 static int
6715 record_unwind_protect_restoring_lisp_object (Lisp_Object *addr, 6714 record_unwind_protect_restoring_lisp_object (Lisp_Object *addr,
6716 Lisp_Object val) 6715 Lisp_Object val)
6717 { 6716 {
6718 Lisp_Object opaque = make_opaque_ptr (addr); 6717 /* We use a cons rather than a malloc()ed structure because we want the
6718 Lisp object to have garbage-collection protection */
6719 Lisp_Object laddr = STORE_VOID_IN_LISP (addr);
6719 return record_unwind_protect (restore_lisp_object, 6720 return record_unwind_protect (restore_lisp_object,
6720 noseeum_cons (opaque, val)); 6721 noseeum_cons (laddr, val));
6721 } 6722 }
6722 6723
6723 /* Similar to specbind() but for any C variable whose value is a 6724 /* Similar to specbind() but for any C variable whose value is a
6724 Lisp_Object. Sets up an unwind-protect to restore the variable 6725 Lisp_Object. Sets up an unwind-protect to restore the variable
6725 pointed to by ADDR to its existing value, and then changes its 6726 pointed to by ADDR to its existing value, and then changes its
6732 record_unwind_protect_restoring_lisp_object (addr, *addr); 6733 record_unwind_protect_restoring_lisp_object (addr, *addr);
6733 *addr = newval; 6734 *addr = newval;
6734 return count; 6735 return count;
6735 } 6736 }
6736 6737
6738 struct restore_int
6739 {
6740 int *addr;
6741 int val;
6742 };
6743
6737 static Lisp_Object 6744 static Lisp_Object
6738 restore_int (Lisp_Object cons) 6745 restore_int (Lisp_Object obj)
6739 { 6746 {
6740 Lisp_Object opaque = XCAR (cons); 6747 struct restore_int *ri = (struct restore_int *) GET_VOID_FROM_LISP (obj);
6741 Lisp_Object lval = XCDR (cons); 6748 *(ri->addr) = ri->val;
6742 int *addr = (int *) get_opaque_ptr (opaque); 6749 xfree (ri);
6743 int val;
6744
6745 /* In the event that a C integer will always fit in an Emacs int, we
6746 haven't ever stored a C integer as an opaque pointer. This #ifdef
6747 eliminates a warning on AMD 64, where EMACS_INT has 63 value bits and C
6748 integers have 32 value bits. */
6749 #if INT_VALBITS < INTBITS
6750 if (INTP (lval))
6751 {
6752 val = XINT (lval);
6753 }
6754 else
6755 {
6756 val = (int) get_opaque_ptr (lval);
6757 free_opaque_ptr (lval);
6758 }
6759 #else /* !(INT_VALBITS < INTBITS) */
6760 val = XINT(lval);
6761 #endif /* INT_VALBITS < INTBITS */
6762
6763 *addr = val;
6764 free_opaque_ptr (opaque);
6765 free_cons (cons);
6766 return Qnil; 6750 return Qnil;
6767 } 6751 }
6768 6752
6769 /* Establish an unwind-protect which will restore the int pointed to 6753 /* Establish an unwind-protect which will restore the int pointed to
6770 by ADDR with the value VAL. This function works correctly with 6754 by ADDR with the value VAL. This function works correctly with
6771 all ints, even those that don't fit into a Lisp integer. */ 6755 all ints, even those that don't fit into a Lisp integer. */
6772 int 6756 int
6773 record_unwind_protect_restoring_int (int *addr, int val) 6757 record_unwind_protect_restoring_int (int *addr, int val)
6774 { 6758 {
6775 Lisp_Object opaque = make_opaque_ptr (addr); 6759 struct restore_int *ri = xnew (struct restore_int);
6776 Lisp_Object lval; 6760 ri->addr = addr;
6777 6761 ri->val = val;
6778 /* In the event that a C integer will always fit in an Emacs int, we don't 6762 return record_unwind_protect (restore_int, STORE_VOID_IN_LISP (ri));
6779 ever want to store a C integer as an opaque pointer. This #ifdef
6780 eliminates a warning on AMD 64, where EMACS_INT has 63 value bits and C
6781 integers have 32 value bits. */
6782 #if INT_VALBITS <= INTBITS
6783 if (NUMBER_FITS_IN_AN_EMACS_INT (val))
6784 lval = make_int (val);
6785 else
6786 lval = make_opaque_ptr ((void *) val);
6787 #else /* !(INT_VALBITS < INTBITS) */
6788 lval = make_int (val);
6789 #endif /* INT_VALBITS <= INTBITS */
6790
6791 return record_unwind_protect (restore_int, noseeum_cons (opaque, lval));
6792 } 6763 }
6793 6764
6794 /* Similar to specbind() but for any C variable whose value is an int. 6765 /* Similar to specbind() but for any C variable whose value is an int.
6795 Sets up an unwind-protect to restore the variable pointed to by 6766 Sets up an unwind-protect to restore the variable pointed to by
6796 ADDR to its existing value, and then changes its value to NEWVAL. 6767 ADDR to its existing value, and then changes its value to NEWVAL.
6807 } 6778 }
6808 6779
6809 static Lisp_Object 6780 static Lisp_Object
6810 free_pointer (Lisp_Object opaque) 6781 free_pointer (Lisp_Object opaque)
6811 { 6782 {
6812 xfree (get_opaque_ptr (opaque)); 6783 void *ptr = GET_VOID_FROM_LISP (opaque);
6813 free_opaque_ptr (opaque); 6784 xfree (ptr);
6814 return Qnil; 6785 return Qnil;
6815 } 6786 }
6816 6787
6817 /* Establish an unwind-protect which will free the specified block. 6788 /* Establish an unwind-protect which will free the specified block.
6818 */ 6789 */
6819 int 6790 int
6820 record_unwind_protect_freeing (void *ptr) 6791 record_unwind_protect_freeing (void *ptr)
6821 { 6792 {
6822 Lisp_Object opaque = make_opaque_ptr (ptr); 6793 return record_unwind_protect (free_pointer, STORE_VOID_IN_LISP (ptr));
6823 return record_unwind_protect (free_pointer, opaque);
6824 } 6794 }
6825 6795
6826 static Lisp_Object 6796 static Lisp_Object
6827 free_dynarr (Lisp_Object opaque) 6797 free_dynarr (Lisp_Object opaque)
6828 { 6798 {
6829 Dynarr_free (get_opaque_ptr (opaque)); 6799 Dynarr_free (GET_VOID_FROM_LISP (opaque));
6830 free_opaque_ptr (opaque);
6831 return Qnil; 6800 return Qnil;
6832 } 6801 }
6833 6802
6834 int 6803 int
6835 record_unwind_protect_freeing_dynarr (void *ptr) 6804 record_unwind_protect_freeing_dynarr (void *ptr)
6836 { 6805 {
6837 Lisp_Object opaque = make_opaque_ptr (ptr); 6806 return record_unwind_protect (free_dynarr, STORE_VOID_IN_LISP (ptr));
6838 return record_unwind_protect (free_dynarr, opaque);
6839 } 6807 }
6840 6808
6841 /* Unwind the stack till specpdl_depth() == COUNT. 6809 /* Unwind the stack till specpdl_depth() == COUNT.
6842 VALUE is not used, except that, purely as a convenience to the 6810 VALUE is not used, except that, purely as a convenience to the
6843 caller, it is protected from garbage-protection and returned. */ 6811 caller, it is protected from garbage-protection and returned. */