Mercurial > hg > xemacs-beta
changeset 5020:eadd99984bfb
merge
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 09 Feb 2010 03:53:52 -0600 |
| parents | d7cc9553d3eb (diff) ecdc03ef6e12 (current diff) |
| children | 4e784bfabae7 |
| files | lisp/ChangeLog src/ChangeLog src/lisp.h |
| diffstat | 67 files changed, 1040 insertions(+), 594 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Mon Feb 08 20:45:21 2010 -0500 +++ b/ChangeLog Tue Feb 09 03:53:52 2010 -0600 @@ -1,3 +1,10 @@ +2010-02-08 Ben Wing <ben@xemacs.org> + + * configure: + * configure.ac (TAB): + Various warnings that used to be present had mistakenly gotten + turned off. Turn them back on. + 2010-02-06 Ben Wing <ben@xemacs.org> * configure:
--- a/configure Mon Feb 08 20:45:21 2010 -0500 +++ b/configure Tue Feb 09 03:53:52 2010 -0600 @@ -9646,18 +9646,24 @@ test "$__GCC" -ge 3 && with_cflags_warning="$with_cflags_warning -Wpacked" test "$have_glibc" != "yes" && \ with_cflags_warning="$with_cflags_warning -Wpointer-arith" - if test "$XEMACS_CC_GPP" = "yes"; then - xe_cflags_warning="$with_cflags_warning -Weffc++" - elif test "$__GCC" -ge 3; then - xe_cflags_warning="$with_cflags_warning -Wunused-parameter" + with_cflags_warning_c="-Wshadow -Wmissing-declarations" + with_cflags_warning_c="$with_cflags_warning_c -Wmissing-prototypes -Wstrict-prototypes" + with_cflags_warning_cxx="-Weffc++" + with_cflags_warning_c_xe="" + if test "$__GCC" -ge 3; then + with_cflags_warning_c_xe="$with_cflags_warning_c_xe -Wunused-parameter" if test "$__GCC" -gt 3 || test "$__GCC_MINOR" -ge 4; then - with_cflags_warning="$with_cflags_warning -Wdeclaration-after-statement" + with_cflags_warning_c="$with_cflags_warning_c -Wdeclaration-after-statement" fi fi - with_cflags_warning="$with_cflags_warning -Wshadow -Wmissing-declarations" - with_cflags_warning="$with_cflags_warning -Wmissing-prototypes -Wstrict-prototypes" - elif test "$__ICC" = "yes"; then - with_cflags_warning="-Wall -w1 -we147" + if test "$XEMACS_CC_GPP" = "yes"; then + xe_cflags_warning="$with_cflags_warning $with_cflags_warning_cxx" + else + xe_cflags_warning="$with_cflags_warning $with_cflags_warning_c $with_cflags_warning_c_xe" + fi + with_cflags_warning="$with_cflags_warning $with_cflags_warning_c" + elif test "$__ICC" = "yes"; then + with_cflags_warning="-Wall -w1 -we147" fi fi test -z "$xe_cflags_warning" && xe_cflags_warning="$with_cflags_warning"
--- a/configure.ac Mon Feb 08 20:45:21 2010 -0500 +++ b/configure.ac Tue Feb 09 03:53:52 2010 -0600 @@ -2053,28 +2053,52 @@ dnl Ulrich Drepper has rejected patches to fix the glibc header files. test "$have_glibc" != "yes" && \ with_cflags_warning="$with_cflags_warning -Wpointer-arith" + dnl dnl Warning flags that may differ for gcc and g++ (xemacs_compiler) + dnl dnl With g++, -Wshadow produces five zillion utterly random warnings -- dnl a local var named `buffer' conflicts with `struct buffer' for dnl example. Even with gcc, -Wshadow is questionable because of its dnl complaints about parameters with the same names as global functions. - dnl There is no -Wmissing-declarations under g++. + dnl There is no -Wmissing-declarations, -Wmissing-prototypes, or + dnl -Wstrict-prototypes under g++. dnl But gcc warns about -Weffc++ in C compiles. + dnl + dnl with_cflags_warning_c is for C-only warnings. + dnl with_cflags_warning_cxx is for C++-only warnings. + dnl with_cflags_warning_c_xe is for C-only warnings and only when + dnl compiling the source tree (i.e. when --xemacs-compiler is used). + with_cflags_warning_c="-Wshadow -Wmissing-declarations" + with_cflags_warning_c="$with_cflags_warning_c -Wmissing-prototypes -Wstrict-prototypes" + with_cflags_warning_cxx="-Weffc++" + with_cflags_warning_c_xe="" + dnl -Wunused-parameter only appeared in gcc 3. + dnl -Wdeclaration-after-statement only appeared in gcc 3.4, and is C-only. + dnl -Wunused-parameter is too annoying for use in lib-src, partly because + dnl the UNUSED() decl is in compiler.h and we don't include that in any + dnl of the lib-src files. dnl With g++, there is no effective way to use -Wunused-parameter without dnl some very ugly code changes. - if test "$XEMACS_CC_GPP" = "yes"; then - xe_cflags_warning="$with_cflags_warning -Weffc++" - elif test "$__GCC" -ge 3; then - xe_cflags_warning="$with_cflags_warning -Wunused-parameter" + if test "$__GCC" -ge 3; then + with_cflags_warning_c_xe="$with_cflags_warning_c_xe -Wunused-parameter" if test "$__GCC" -gt 3 || test "$__GCC_MINOR" -ge 4; then - with_cflags_warning="$with_cflags_warning -Wdeclaration-after-statement" + with_cflags_warning_c="$with_cflags_warning_c -Wdeclaration-after-statement" fi fi - with_cflags_warning="$with_cflags_warning -Wshadow -Wmissing-declarations" - with_cflags_warning="$with_cflags_warning -Wmissing-prototypes -Wstrict-prototypes" - dnl **** If more gcc/g++ flags are added, from here on must handle - dnl **** with_cflags_warning and xe_cflags_warning in parallel + dnl **** If more gcc/g++ flags are added, add them above, not below + dnl + dnl Now set warnings for the source tree (xe_cflags_warning) and for + dnl lib-src (with_cflags_warning). Note that if we didn't set + dnl xe_cflags_warning, it would automatically be initialized from + dnl with_cflags_warning. + if test "$XEMACS_CC_GPP" = "yes"; then + xe_cflags_warning="$with_cflags_warning $with_cflags_warning_cxx" + else + xe_cflags_warning="$with_cflags_warning $with_cflags_warning_c $with_cflags_warning_c_xe" + fi + with_cflags_warning="$with_cflags_warning $with_cflags_warning_c" elif test "$__ICC" = "yes"; then + dnl This will apply to both source tree and lib-src with_cflags_warning="-Wall -w1 -we147" dnl ### Add optimal with_cflags_warning support for other compilers HERE! fi
--- a/lisp/ChangeLog Mon Feb 08 20:45:21 2010 -0500 +++ b/lisp/ChangeLog Tue Feb 09 03:53:52 2010 -0600 @@ -1,3 +1,10 @@ +2010-02-08 Ben Wing <ben@xemacs.org> + + * help.el (describe-function-1): + Don't use compiled-function-annotation to retrieve the file name + for a function since it doesn't provide this info and load-history + already does provide it. + 2010-02-07 Aidan Kehoe <kehoea@parhasard.net> * make-docfile.el (format-decode): Remove this temporary function
--- a/lisp/help.el Mon Feb 08 20:45:21 2010 -0500 +++ b/lisp/help.el Tue Feb 09 03:53:52 2010 -0600 @@ -1385,15 +1385,8 @@ (symbol-name def))) (format "an alias for `%s', " (symbol-name def))))) (setq def (symbol-function def))) - (if (and (fboundp 'compiled-function-annotation) - (compiled-function-p def)) - (setq file-name (declare-fboundp (compiled-function-annotation def)))) (if (eq 'macro (car-safe def)) (setq fndef (cdr def) - file-name (and (compiled-function-p (cdr def)) - (fboundp 'compiled-function-annotation) - (declare-fboundp - (compiled-function-annotation (cdr def)))) macrop t) (setq fndef def)) (if aliases (princ aliases))
--- a/lwlib/ChangeLog Mon Feb 08 20:45:21 2010 -0500 +++ b/lwlib/ChangeLog Tue Feb 09 03:53:52 2010 -0600 @@ -1,3 +1,10 @@ +2010-02-08 Ben Wing <ben@xemacs.org> + + * xt-wrappers.h: + * xt-wrappers.h (Xt_SET_VALUE): + * xt-wrappers.h (Xt_GET_VALUE): + Rename var to avoid shadowing problems. + 2010-01-24 Ben Wing <ben@xemacs.org> * xlwgauge.c (GaugeResize):
--- a/lwlib/xt-wrappers.h Mon Feb 08 20:45:21 2010 -0500 +++ b/lwlib/xt-wrappers.h Tue Feb 09 03:53:52 2010 -0600 @@ -89,15 +89,15 @@ /* Convenience macros for getting/setting one resource value. */ #define Xt_SET_VALUE(widget, resource, value) do { \ - Arg al; \ - Xt_SET_ARG (al, resource, value); \ - XtSetValues (widget, &al, 1); \ + Arg al__; \ + Xt_SET_ARG (al__, resource, value); \ + XtSetValues (widget, &al__, 1); \ } while (0) #define Xt_GET_VALUE(widget, resource, location) do { \ - Arg al; \ - Xt_SET_ARG (al, resource, location); \ - XtGetValues (widget, &al, 1); \ + Arg al__; \ + Xt_SET_ARG (al__, resource, location); \ + XtGetValues (widget, &al__, 1); \ } while (0) #endif /* INCLUDED_xt_wrappers_h_ */
--- a/man/ChangeLog Mon Feb 08 20:45:21 2010 -0500 +++ b/man/ChangeLog Tue Feb 09 03:53:52 2010 -0600 @@ -1,3 +1,10 @@ +2010-02-08 Ben Wing <ben@xemacs.org> + + * internals/internals.texi (How Lisp Objects Are Represented in C): + * internals/internals.texi (Allocation of Objects in XEmacs Lisp): + DEC Alpha is hardly the only 64-bit processor any more. + Also, ERROR_CHECK_TYPECHECK is now ERROR_CHECK_TYPES. + 2010-02-05 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules):
--- a/man/internals/internals.texi Mon Feb 08 20:45:21 2010 -0500 +++ b/man/internals/internals.texi Tue Feb 09 03:53:52 2010 -0600 @@ -7601,10 +7601,9 @@ @cindex objects are represented in C, how Lisp @cindex represented in C, how Lisp objects are -Lisp objects are represented in C using a 32-bit or 64-bit machine word -(depending on the processor; i.e. DEC Alphas use 64-bit Lisp objects and -most other processors use 32-bit Lisp objects). The representation -stuffs a pointer together with a tag, as follows: +Lisp objects are represented in C using a 32-bit or 64-bit machine +word (depending on the processor). The representation stuffs a +pointer together with a tag, as follows: @example [ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 ] @@ -7624,18 +7623,17 @@ Lisp objects use the typedef @code{Lisp_Object}, but the actual C type used for the Lisp object can vary. It can be either a simple type -(@code{long} on the DEC Alpha, @code{int} on other machines) or a -structure whose fields are bit fields that line up properly (actually, a -union of structures is used). Generally the simple integral type is -preferable because it ensures that the compiler will actually use a -machine word to represent the object (some compilers will use more -general and less efficient code for unions and structs even if they can -fit in a machine word). The union type, however, has the advantage of -stricter type checking. If you accidentally pass an integer where a Lisp -object is desired, you get a compile error. The choice of which type -to use is determined by the preprocessor constant @code{USE_UNION_TYPE} -which is defined via the @code{--use-union-type} option to -@code{configure}. +(generally @code{long}) or a structure whose fields are bit fields +that line up properly (actually, a union of structures is used). +Generally the simple integral type is preferable because it ensures +that the compiler will actually use a machine word to represent the +object (some compilers will use more general and less efficient code +for unions and structs even if they can fit in a machine word). The +union type, however, has the advantage of stricter type checking. If +you accidentally pass an integer where a Lisp object is desired, you +get a compile error. The choice of which type to use is determined by +the preprocessor constant @code{USE_UNION_TYPE} which is defined via +the @code{--use-union-type} option to @code{configure}. Various macros are used to convert between Lisp_Objects and the corresponding C type. Macros of the form @code{XINT()}, @code{XCHAR()}, @@ -7648,7 +7646,7 @@ negative numbers) the shift to remove the tag bit is enough. This is the case on all the systems we support. -Note that when @code{ERROR_CHECK_TYPECHECK} is defined, the converter +Note that when @code{ERROR_CHECK_TYPES} is defined, the converter macros become more complicated---they check the tag bits and/or the type field in the first four bytes of a record type to ensure that the object is really of the correct type. This is great for catching places @@ -7665,7 +7663,7 @@ can use the function @code{make_int()}, which constructs and @emph{returns} an integer Lisp object. Note that the @code{XSET@var{TYPE}()} macros are also affected by -@code{ERROR_CHECK_TYPECHECK} and make sure that the structure is of the +@code{ERROR_CHECK_TYPES} and make sure that the structure is of the right type in the case of record types, where the type is contained in the structure. @@ -7676,15 +7674,11 @@ else use @code{Fcar()} and @code{Fcdr()}. Trust other C code, but not Lisp code. On the other hand, if XEmacs has an internal logic error, it's better to crash immediately, so sprinkle @code{assert()}s and -``unreachable'' @code{abort()}s liberally about the source code. Where -performance is an issue, use @code{type_checking_assert}, -@code{bufpos_checking_assert}, and @code{gc_checking_assert}, which do -nothing unless the corresponding configure error checking flag was -specified. - -Note that in some cases @samp{assert}s will expand to nothing in a -context where that produces an empty statement. Some compilers will -warn about this. +``unreachable'' @code{abort()}s liberally about the source code. +Where performance is an issue, use @code{type_checking_assert}, +@code{bufpos_checking_assert}, @code{gc_checking_assert}, and the +like, which do nothing unless the corresponding configure error +checking flag was specified. @node Allocation of Objects in XEmacs Lisp, The Lisp Reader and Compiler, How Lisp Objects Are Represented in C, Top @chapter Allocation of Objects in XEmacs Lisp
--- a/src/ChangeLog Mon Feb 08 20:45:21 2010 -0500 +++ b/src/ChangeLog Tue Feb 09 03:53:52 2010 -0600 @@ -1,3 +1,304 @@ +2010-02-08 Ben Wing <ben@xemacs.org> + + * charset.h: + * charset.h (Fget_charset): Declare some fake charset defs so + we can compile when non-Mule. + * depend: Rebuild. + +2010-02-08 Ben Wing <ben@xemacs.org> + + * event-Xt.c: + Add comment about simultaneous window-system consoles/devices. + +2010-02-08 Ben Wing <ben@xemacs.org> + + * alloc.c: + Add prototypes for debugging functions. + + * alloc.c (compact_string_chars): Make static. + + * console-x.c (x_initially_selected_for_input): + * console-x.h: + * console-x.h (X_ERROR_OCCURRED): + Delete x_has_keysym() prototype from console-x.c, move to console-x.h. + + * eval.c (multiple_value_call): + Real bug: Fix shadowing local vars. + + * event-unixoid.c (read_event_from_tty_or_stream_desc): + * event-unixoid.c (signal_fake_event): + * lread.c (check_if_suppressed): + * strftime.c (strftime): + Fix stupid global shadowing warnings. + + * event-unixoid.c (signal_fake_event): + * event-unixoid.c (drain_signal_event_pipe): + Use Rawbyte, not char. + + * frame.h: Remove old prototype. + + * gc.c: + * gc.c (show_gc_cursor_and_message): + * gc.c (remove_gc_cursor_and_message): + * gc.c (gc_prepare): + * gc.c (gc_finish_mark): + * gc.c (gc_finalize): + * gc.c (gc_sweep): + * gc.c (gc_finish): + * gc.c (gc_suspend_mark_phase): + * gc.c (gc_resume_mark_phase): + * gc.c (gc_mark): + * gc.c (gc_resume_mark): + Make fns static. + + * glyphs-eimage.c (gif_decode_error_string): + Fix non-prototype. + + * lisp.h: + Hack around global shadowing warnings involving `index'. + + * intl-win32.c (wcsncpy): + * number-gmp.c (bigfloat_to_string): + * objects-msw.c (mswindows_font_spec_matches_charset_stage_2): + * specifier.c (call_charset_predicate): + * specifier.c (DEFINE_SPECIFIER_TAG_FROB): + Declarations cannot follow statements in standard C. + + * search.c (search_buffer): Fix local shadowing warnings. + +2010-02-08 Ben Wing <ben@xemacs.org> + + * faces.c: + * faces.c (face_property_matching_instance): + * faces.c (ensure_face_cachel_contains_charset): + * faces.h (FACE_FONT): + * lisp.h: + * lisp.h (enum font_specifier_matchspec_stages): + * objects-msw.c: + * objects-msw.c (mswindows_font_spec_matches_charset): + * objects-msw.c (mswindows_find_charset_font): + * objects-tty.c: + * objects-tty.c (tty_font_spec_matches_charset): + * objects-tty.c (tty_find_charset_font): + * objects-xlike-inc.c: + * objects-xlike-inc.c (XFUN): + * objects-xlike-inc.c (xft_find_charset_font): + * objects.c: + * objects.c (font_instantiate): + * objects.c (FROB): + * specifier.c: + * specifier.c (charset_matches_specifier_tag_set_p): + * specifier.c (call_charset_predicate): + * specifier.c (define_specifier_tag): + * specifier.c (Fdefine_specifier_tag): + * specifier.c (setup_charset_initial_specifier_tags): + * specifier.c (specifier_instance_from_inst_list): + * specifier.c (FROB): + * specifier.c (vars_of_specifier): + * specifier.h: + Rename the specifier-font-matching stages in preparation for + eliminating shadowed warnings, some other related fixes from + ben-unicode-internal. + + 1. Rename raw enums: + initial -> STAGE_INITIAL + final -> STAGE_FINAL + impossible -> NUM_MATCHSPEC_STAGES + 2. Move `enum font_specifier_matchspec_stages' from + specifier.h to lisp.h. + 3. Whitespace changes to match coding standards. + 4. Eliminate unused second argument STAGE in charset predicates + that don't use it -- the code that calls the charset predicates + is now smart enough to supply the right number of arguments + automatically. + 5. Add some long(ish) comments and authorial notices, esp. in + objects.c. + 6. In specifier.c, change Vcharset_tag_lists from a vector over + leading bytes to a hash table over charsets. This change is + unnecessary currently but doesn't hurt and will be required + when we merge in Unicode-internal. + 7. In specifier.c, extract out the code that calls charset predicates + into a function call_charset_predicate(). + +2010-02-08 Ben Wing <ben@xemacs.org> + + * emacs.c: + * emacs.c (assert_failed): + Fix comments about when inhibit_non_essential_printing_operations + is set and how used. Increment/decrement in assert_failed rather + than just setting/resetting to avoid hosing things in case we're + called when the value is already non-zero. Similarly increment/ + decrement in_assert_failed. + + * gc.c (gc_prepare): + * gc.c (gc_finish): + Increment/decrement inhibit_non_essential_printing_operations + rather than setting/resetting. + + * print.c: + * print.c (debug_out): + * print.c (write_string_to_alternate_debugging_output): + * print.c (restore_inhibit_non_essential_conversion_operations): + * print.c (debug_print_exit): + * print.c (debug_print_enter): + * print.c (debug_prin1): + * print.c (debug_p4): + * print.c (ext_print_begin): + * print.c (ext_print_end): + * print.c (external_debug_print): + * print.c (debug_p3): + * print.c (debug_backtrace): + * print.c (debug_short_backtrace): + * print.c (vars_of_print): + Lots of cleanup. Fix debug_out() so it binds + inhibit_non_essential_printing_operations around it to ensure no + conversion. Remove many other places that set the same var since + the lower-level functions now all do it. A few other places, add + inhibit_non_essential_printing_operations bindings.Extract the + code out that sets up and resets lots of bindings in debug_prin1() + so that debug_backtrace() can use it, and rewrite it to use the + new STORE_VOID_IN_LISP() rather than having to have a single + static opaque structure holding all the bindings (and not handling + reentrancy). Fix raw `char' to be `CIbyte' in the declaration of + `alternate_do_string'. + + * signal.c (check_what_happened): + Fix bug: Don't try to check for QUIT when + inhibit_non_essential_printing_operations or we may screw things + up if QUIT happens during debug printing. + +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-08 Vin Shelton <acs@xemacs.org> * nt.c (open_unc_volume): lpRemoteName is an XELPTSTR.
--- a/src/alloc.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/alloc.c Tue Feb 09 03:53:52 2010 -0600 @@ -3304,6 +3304,8 @@ dump_add_root_lisp_object (varaddress); } +const Ascbyte *staticpro_name (int count); + /* External debugging function: Return the name of the variable at offset COUNT. */ const Ascbyte * @@ -3324,6 +3326,8 @@ Dynarr_add (staticpro_nodump_names, varname); } +const Ascbyte *staticpro_nodump_name (int count); + /* External debugging function: Return the name of the variable at offset COUNT. */ const Ascbyte * @@ -4136,7 +4140,7 @@ #ifndef NEW_GC /* Compactify string chars, relocating the reference to each -- free any empty string_chars_block we see. */ -void +static void compact_string_chars (void) { struct string_chars_block *to_sb = first_string_chars_block;
--- a/src/casetab.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/casetab.c Tue Feb 09 03:53:52 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/charset.h Mon Feb 08 20:45:21 2010 -0500 +++ b/src/charset.h Tue Feb 09 03:53:52 2010 -0600 @@ -60,6 +60,8 @@ } while (0) #define XCHARSET_CCL_PROGRAM(cs) Qnil #define XCHARSET_NAME(cs) Qascii +#define Fget_charset(cs) (cs) +#define Fcharset_list() list1 (Vcharset_ascii) #else /* MULE */
--- a/src/chartab.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/chartab.c Tue Feb 09 03:53:52 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-x.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/console-x.c Tue Feb 09 03:53:52 2010 -0600 @@ -43,8 +43,6 @@ int wedge_metacity; /* nonzero means update WM_HINTS always */ -extern void x_has_keysym (KeySym, Lisp_Object, int); - static int x_initially_selected_for_input (struct console *UNUSED (con)) {
--- a/src/console-x.h Mon Feb 08 20:45:21 2010 -0500 +++ b/src/console-x.h Tue Feb 09 03:53:52 2010 -0600 @@ -145,6 +145,7 @@ int x_initialize_frame_menubar (struct frame *f); void x_init_modifier_mapping (struct device *d); +void x_has_keysym (KeySym, Lisp_Object, int); int x_frame_window_state (struct frame *f);
--- a/src/console.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/console.c Tue Feb 09 03:53:52 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/depend Mon Feb 08 20:45:21 2010 -0500 +++ b/src/depend Tue Feb 09 03:53:52 2010 -0600 @@ -222,7 +222,7 @@ sheap.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sheap-adjust.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h signal.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h syswindows.h text.h vdb.h sound.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h sound.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h xintrinsic.h -specifier.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h frame.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h +specifier.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h frame.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h strcat.o: $(CONFIG_H) strftime.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h sunplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h syswindows.h text.h vdb.h
--- a/src/device.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/device.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/dialog-msw.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/dialog-x.c Tue Feb 09 03:53:52 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/emacs.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/emacs.c Tue Feb 09 03:53:52 2010 -0600 @@ -670,8 +670,11 @@ int preparing_for_armageddon; /* Nonzero means we're in an unstable situation and need to skip - i18n conversions and such. During printing we check for this, - and during conversion we abort if we see this. */ + internal->external conversions, QUIT checking and such. This gets set + during early startup, during shutdown, and when debug printing + (i.e. called from a debugger such as gdb to print Lisp objects or + backtraces). During printing we check for this, and during conversion + we abort if we see this. */ int inhibit_non_essential_conversion_operations; static JMP_BUF run_temacs_catch; @@ -3967,7 +3970,7 @@ /* We are extremely paranoid so we sensibly deal with recursive assertion failures. */ in_assert_failed++; - inhibit_non_essential_conversion_operations = 1; + inhibit_non_essential_conversion_operations++; if (in_assert_failed >= 4) _exit (-1); @@ -4035,8 +4038,8 @@ really_abort (); #endif /* defined (_MSC_VER) || defined (CYGWIN) */ #endif /* !defined (ASSERTIONS_DONT_ABORT) */ - inhibit_non_essential_conversion_operations = 0; - in_assert_failed = 0; + inhibit_non_essential_conversion_operations--; + in_assert_failed--; } /* -------------------------------------- */
--- a/src/eval.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/eval.c Tue Feb 09 03:53:52 2010 -0600 @@ -4723,11 +4723,11 @@ if (MULTIPLE_VALUEP (result)) { Lisp_Object val; - Elemcount i, count = XMULTIPLE_VALUE_COUNT (result); - - for (i = 0; i < count; i++) + Elemcount j, count = XMULTIPLE_VALUE_COUNT (result); + + for (j = 0; j < count; j++) { - val = multiple_value_aref (result, i); + val = multiple_value_aref (result, j); assert (!UNBOUNDP (val)); XSETCDR (list_offset, Fcons (val, Qnil)); @@ -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-Xt.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/event-Xt.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,7 +1,7 @@ /* The event_stream interface for X11 with Xt, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. @@ -22,6 +22,14 @@ /* Synched up with: Not in FSF. */ +/* NOTE: It would be possible to fix things so that all of GTK, Windows, X, + TTY and stream can have consoles at the same time. We already do lots + of combinations. Basically, either call select() directly or some + interface onto it, and select() over all the filedescs, including the + X and GTK socket, and under Cygwin, the Windows device. Then for whichever + filedesc there's an event, call the appropriate window-system-specific + method to pull the event(s) and store onto the dispatch queue. --ben */ + #include <config.h> #include "lisp.h"
--- a/src/event-msw.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/event-msw.c Tue Feb 09 03:53:52 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/event-unixoid.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/event-unixoid.c Tue Feb 09 03:53:52 2010 -0600 @@ -100,16 +100,16 @@ ch = Lstream_get_ichar (XLSTREAM (CONSOLE_TTY_DATA (con)->instream)); else { - Ibyte byte; + Ibyte ibyte; /* #### Definitely something strange here. We should be setting the stdio handle unbuffered and reading from it instead of mixing stdio and raw io calls. */ int nread = retry_read (fileno (CONSOLE_STREAM_DATA (con)->in), - &byte, 1); + &ibyte, 1); if (nread <= 0) ch = -1; else - ch = byte; + ch = ibyte; } if (ch < 0) @@ -132,7 +132,7 @@ void signal_fake_event (void) { - char byte = 0; + Rawbyte rbyte = 0; /* We do the write always. Formerly I tried to "optimize" this by setting a flag indicating whether we're blocking and only doing the write in that case, but there is a race condition @@ -148,7 +148,7 @@ /* In case a signal comes through while we're dumping */ { int old_errno = errno; - retry_write (signal_event_pipe[1], &byte, 1); + retry_write (signal_event_pipe[1], &rbyte, 1); errno = old_errno; } } @@ -156,7 +156,7 @@ void drain_signal_event_pipe (void) { - char chars[128]; + Rawbyte chars[128]; /* The input end of the pipe has been set to non-blocking. */ while (retry_read (signal_event_pipe[0], chars, sizeof (chars)) > 0) ;
--- a/src/faces.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/faces.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,7 +1,7 @@ /* "Face" primitives Copyright (C) 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2005, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs. @@ -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)) { @@ -589,16 +589,20 @@ if (!NILP (charset)) matchspec = noseeum_cons (charset, - stage == initial ? Qinitial : Qfinal); + stage == STAGE_INITIAL ? Qinitial : Qfinal); GCPRO1 (matchspec); + /* This call to specifier_instance_no_quit(), will end up calling + font_instantiate() if the property in a question is a font (currently, + this means EQ (property, Qfont), because only the face property named + `font' contains a font object). See the comments there. */ retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec, domain, errb, no_fallback, depth); UNGCPRO; if (CONSP (matchspec)) free_cons (matchspec); - if (UNBOUNDP (retval) && !no_fallback && final == stage) + if (UNBOUNDP (retval) && !no_fallback && STAGE_FINAL == stage) { if (EQ (property, Qfont)) { @@ -1159,7 +1163,7 @@ /* ERROR_ME_DEBUG_WARN is fine here. */ ERROR_ME_DEBUG_WARN, 1, Qzero, - initial); + STAGE_INITIAL); DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " "result was something %s\n", XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), @@ -1181,15 +1185,15 @@ charset, domain, ERROR_ME_DEBUG_WARN, 0, Qzero, - initial); + STAGE_INITIAL); - DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " - "allow fallback, result was something %s\n", - XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), - XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), - UNBOUNDP(new_val) ? "not bound" : "bound"); + DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, " + "allow fallback, result was something %s\n", + XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)), + XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))), + UNBOUNDP (new_val) ? "not bound" : "bound"); - if (!UNBOUNDP(new_val)) + if (!UNBOUNDP (new_val)) { break; } @@ -1200,7 +1204,7 @@ charset, domain, ERROR_ME_DEBUG_WARN, 1, Qzero, - final); + STAGE_FINAL); DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, " "result was something %s\n", @@ -1208,7 +1212,7 @@ XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), UNBOUNDP(new_val) ? "not bound" : "bound"); /* Tell X11 redisplay that it should translate to iso10646-1. */ - if (!UNBOUNDP(new_val)) + if (!UNBOUNDP (new_val)) { final_stage = 1; break; @@ -1222,13 +1226,13 @@ charset, domain, ERROR_ME_DEBUG_WARN, 0, Qzero, - final); + STAGE_FINAL); - DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " - "allow fallback, result was something %s\n", - XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), - XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), - UNBOUNDP(new_val) ? "not bound" : "bound"); + DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, " + "allow fallback, result was something %s\n", + XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)), + XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))), + UNBOUNDP (new_val) ? "not bound" : "bound"); if (!UNBOUNDP(new_val)) { /* Tell X11 redisplay that it should translate to iso10646-1. */ @@ -2029,30 +2033,30 @@ DEFUN ("specifier-tag-one-dimensional-p", Fspecifier_tag_one_dimensional_p, - 2, 2, 0, /* + 1, 1, 0, /* Return non-nil if (charset-dimension CHARSET) is 1. Used by the X11 platform font code; see `define-specifier-tag'. You shouldn't ever need to call this yourself. */ - (charset, UNUSED(stage))) + (charset)) { - CHECK_CHARSET(charset); - return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; + CHECK_CHARSET (charset); + return (1 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; } DEFUN ("specifier-tag-two-dimensional-p", Fspecifier_tag_two_dimensional_p, - 2, 2, 0, /* + 1, 1, 0, /* Return non-nil if (charset-dimension CHARSET) is 2. Used by the X11 platform font code; see `define-specifier-tag'. You shouldn't ever need to call this yourself. */ - (charset, UNUSED(stage))) + (charset)) { - CHECK_CHARSET(charset); - return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; + CHECK_CHARSET (charset); + return (2 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; } DEFUN ("specifier-tag-final-stage-p", @@ -2063,9 +2067,9 @@ Used by the X11 platform font code for giving fallbacks; see `define-specifier-tag'. You shouldn't ever need to call this. */ - (UNUSED(charset), stage)) + (UNUSED (charset), stage)) { - return EQ(stage, Qfinal) ? Qt : Qnil; + return EQ (stage, Qfinal) ? Qt : Qnil; } DEFUN ("specifier-tag-initial-stage-p",
--- a/src/faces.h Mon Feb 08 20:45:21 2010 -0500 +++ b/src/faces.h Tue Feb 09 03:53:52 2010 -0600 @@ -393,7 +393,7 @@ #define FACE_FONT(face, domain, charset) \ face_property_matching_instance (face, Qfont, charset, domain, \ ERROR_ME_DEBUG_WARN, 0, Qzero, \ - initial) + STAGE_INITIAL) #define FACE_DISPLAY_TABLE(face, domain) \ FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero) #define FACE_BACKGROUND_PIXMAP(face, domain) \
--- a/src/frame-msw.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/frame-msw.c Tue Feb 09 03:53:52 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/frame.h Mon Feb 08 20:45:21 2010 -0500 +++ b/src/frame.h Tue Feb 09 03:53:52 2010 -0600 @@ -154,7 +154,6 @@ void *closure); int device_matches_device_spec (Lisp_Object device, Lisp_Object device_spec); Lisp_Object frame_first_window (struct frame *f); -int show_gc_cursor (struct frame *f, Lisp_Object cursor); void set_frame_selected_window (struct frame *f, Lisp_Object window); int is_surrogate_for_selected_frame (struct frame *f); void update_frame_icon (struct frame *f);
--- a/src/gc.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/gc.c Tue Feb 09 03:53:52 2010 -0600 @@ -1449,7 +1449,7 @@ #define MAX_SAVE_STACK 0 /* 16000 */ #endif -void +static void show_gc_cursor_and_message (void) { /* Now show the GC cursor/message. */ @@ -1506,7 +1506,7 @@ } } -void +static void remove_gc_cursor_and_message (void) { /* Now remove the GC cursor/message */ @@ -1536,7 +1536,7 @@ } } -void +static void gc_prepare (void) { #if MAX_SAVE_STACK > 0 @@ -1568,7 +1568,7 @@ gc_in_progress = 1; #ifndef NEW_GC - inhibit_non_essential_conversion_operations = 1; + inhibit_non_essential_conversion_operations++; #endif /* not NEW_GC */ #if MAX_SAVE_STACK > 0 @@ -1604,7 +1604,7 @@ cleanup_buffer_undo_lists (); } -void +static void gc_mark_root_set ( #ifdef NEW_GC enum gc_phase phase @@ -1711,7 +1711,7 @@ #endif } -void +static void gc_finish_mark (void) { #ifdef NEW_GC @@ -1758,14 +1758,14 @@ } #ifdef NEW_GC -void +static void gc_finalize (void) { GC_SET_PHASE (FINALIZE); register_for_finalization (); } -void +static void gc_sweep (void) { GC_SET_PHASE (SWEEP); @@ -1774,7 +1774,7 @@ #endif /* NEW_GC */ -void +static void gc_finish (void) { #ifdef NEW_GC @@ -1789,7 +1789,7 @@ recompute_need_to_garbage_collect (); #ifndef NEW_GC - inhibit_non_essential_conversion_operations = 0; + inhibit_non_essential_conversion_operations--; #endif /* not NEW_GC */ gc_in_progress = 0; @@ -1815,7 +1815,7 @@ } #ifdef NEW_GC -void +static void gc_suspend_mark_phase (void) { PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); @@ -1824,7 +1824,7 @@ vdb_start_dirty_bits_recording (); } -int +static int gc_resume_mark_phase (void) { PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); @@ -1834,7 +1834,7 @@ return vdb_read_dirty_bits (); } -int +static int gc_mark (int incremental) { GC_SET_PHASE (MARK); @@ -1854,7 +1854,7 @@ return 1; } -int +static int gc_resume_mark (int incremental) { if (!incremental)
--- a/src/glade.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/glade.c Tue Feb 09 03:53:52 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-eimage.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/glyphs-eimage.c Tue Feb 09 03:53:52 2010 -0600 @@ -598,7 +598,7 @@ } static const char * -gif_decode_error_string () +gif_decode_error_string (void) { switch (GifLastError ()) {
--- a/src/glyphs-msw.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/glyphs-msw.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/glyphs.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/gui-x.c Tue Feb 09 03:53:52 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/intl-win32.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/intl-win32.c Tue Feb 09 03:53:52 2010 -0600 @@ -1601,10 +1601,10 @@ wchar_t * wcsncpy (wchar_t *dst0, const wchar_t *src0, size_t count) { - if (dst0 == NULL || src0 == NULL) return NULL; wchar_t *dscan; const wchar_t *sscan; + if (dst0 == NULL || src0 == NULL) return NULL; dscan = dst0; sscan = src0; while (count > 0)
--- a/src/keymap.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/keymap.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/lisp-disunion.h Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/lisp-union.h Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/lisp.h Tue Feb 09 03:53:52 2010 -0600 @@ -99,7 +99,12 @@ large so they shouldn't cause that much of a slowdown. */ #include <stdlib.h> +/* Evil, but ... -Wshadow is genuinely useful but also leads to spurious + warnings when you have a local var named `index'. Avoid this by + hacking around it. */ +#define index old_index #include <string.h> /* primarily for memcpy, etc. */ +#undef index #include <stdio.h> /* NULL, etc. */ #include <ctype.h> #include <stdarg.h> @@ -1596,6 +1601,18 @@ MUNGE_ME_KEY_TRANSLATION }; +/* The various stages of font instantiation; initial means "find a font for + CHARSET that matches the charset's registries" and final means "find a + font for CHARSET that matches iso10646-1, since we haven't found a font + that matches its registry." +*/ +enum font_specifier_matchspec_stages +{ + STAGE_INITIAL, + STAGE_FINAL, + NUM_MATCHSPEC_STAGES, +}; + /* ------------------------------- */ /* misc */ /* ------------------------------- */ @@ -1699,6 +1716,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 +3952,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/lread.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/lread.c Tue Feb 09 03:53:52 2010 -0600 @@ -356,23 +356,23 @@ len -= 3; { - EXTERNAL_LIST_LOOP_2 (acons, Vload_suppress_alist) + EXTERNAL_LIST_LOOP_2 (cons, Vload_suppress_alist) { - if (CONSP (acons) && STRINGP (XCAR (acons))) + if (CONSP (cons) && STRINGP (XCAR (cons))) { - Lisp_Object name = XCAR (acons); - if (XSTRING_LENGTH (name) == len && - !memcmp (XSTRING_DATA (name), nonreloc, len)) + Lisp_Object name = XCAR (cons); + if (XSTRING_LENGTH (name) == len && + !memcmp (XSTRING_DATA (name), nonreloc, len)) { - struct gcpro gcpro1; - Lisp_Object val; - - GCPRO1 (reloc); - val = IGNORE_MULTIPLE_VALUES (Feval (XCDR (acons))); - UNGCPRO; - - if (!NILP (val)) - return 1; + struct gcpro gcpro1; + Lisp_Object val; + + GCPRO1 (reloc); + val = IGNORE_MULTIPLE_VALUES (Feval (XCDR (cons))); + UNGCPRO; + + if (!NILP (val)) + return 1; } } }
--- a/src/menubar-gtk.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/menubar-gtk.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/menubar-msw.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/menubar-x.c Tue Feb 09 03:53:52 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/number-gmp.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/number-gmp.c Tue Feb 09 03:53:52 2010 -0600 @@ -76,18 +76,20 @@ point, format identifier, and exponent */ /* GMP's idea of the exponent is 1 greater than scientific notation's */ expt--; - const int point = (len == neg + 2) ? 0 : 1; - const int exponent = (expt < 0) - ? (int)(log ((double) (-expt)) / log ((double) base)) + 3 - : (int)(log ((double) expt) / log ((double) base)) + 2; - const int space = point + exponent; - XREALLOC_ARRAY (str, CIbyte, len + space); - if (point > 0) - { - memmove (&str[neg + 2], &str[neg + 1], len - neg); - str[neg + 1] = '.'; - } - sprintf (&str[len + point - 1], "E%ld", expt); + { + const int point = (len == neg + 2) ? 0 : 1; + const int exponent = (expt < 0) + ? (int)(log ((double) (-expt)) / log ((double) base)) + 3 + : (int)(log ((double) expt) / log ((double) base)) + 2; + const int space = point + exponent; + XREALLOC_ARRAY (str, CIbyte, len + space); + if (point > 0) + { + memmove (&str[neg + 2], &str[neg + 1], len - neg); + str[neg + 1] = '.'; + } + sprintf (&str[len + point - 1], "E%ld", expt); + } } return str; }
--- a/src/objects-msw.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/objects-msw.c Tue Feb 09 03:53:52 2010 -0600 @@ -2,7 +2,7 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1997 Jonathan Harris. @@ -27,8 +27,9 @@ /* Authorship: - Jamie Zawinski, Chuck Thompson, Ben Wing - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. + This file created by Jonathan Harris, November 1997 for 21.0; based + heavily on objects-x.c (see authorship there). Much further work + by Ben Wing. */ /* This function Mule-ized by Ben Wing, 3-24-02. */ @@ -2016,6 +2017,8 @@ /* +#### The following comment is old and probably not applicable any longer. + 1. handle standard mapping and inheritance vectors properly in Face-frob-property. 2. finish impl of mswindows-charset-registry. 3. see if everything works under fixup, now that i copied the stuff over. @@ -2067,6 +2070,7 @@ { HDC hdc = CreateCompatibleDC (NULL); Lisp_Object font_list = Qnil, truename; + HFONT hfont; if (DEVICE_TYPE_P (d, mswindows)) { @@ -2081,10 +2085,10 @@ assert(0); } - HFONT hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, - font_list, - ERROR_ME_DEBUG_WARN, - &truename); + hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, + font_list, + ERROR_ME_DEBUG_WARN, + &truename); if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont))) { @@ -2184,7 +2188,7 @@ Bytecount offset, Bytecount length, enum font_specifier_matchspec_stages stage) { - return stage ? + return stage == STAGE_FINAL ? mswindows_font_spec_matches_charset_stage_2 (d, charset, nonreloc, reloc, offset, length) : mswindows_font_spec_matches_charset_stage_1 (d, charset, nonreloc, @@ -2206,7 +2210,7 @@ that charset; otherwise, it will list fonts with all charsets. */ fontlist = mswindows_font_list (font, device, Qnil); - if (!stage) + if (stage == STAGE_INITIAL) { LIST_LOOP (fonttail, fontlist) {
--- a/src/objects-tty.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/objects-tty.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,6 +1,6 @@ /* TTY-specific Lisp objects. Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. @@ -345,7 +345,7 @@ { const Ibyte *the_nonreloc = nonreloc; - if (stage) + if (stage == STAGE_FINAL) return 0; if (!the_nonreloc) @@ -374,13 +374,13 @@ { Ibyte *fontname = XSTRING_DATA (font); - if (stage) + if (stage == STAGE_FINAL) return Qnil; if (strchr ((const char *) fontname, '/')) { if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, - font, 0, -1, initial)) + font, 0, -1, STAGE_INITIAL)) return font; return Qnil; }
--- a/src/objects-xlike-inc.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/objects-xlike-inc.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,7 +1,7 @@ /* Common code between X and GTK -- fonts and colors. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. @@ -106,7 +106,7 @@ the_nonreloc += offset; #ifdef USE_XFT - if (stage) + if (stage == STAGE_FINAL) { Display *dpy = DEVICE_X_DISPLAY (d); Extbyte *extname; @@ -146,11 +146,11 @@ return 1; } - if (final == stage) + if (STAGE_FINAL == stage) { registries = Qunicode_registries; } - else if (initial == stage) + else if (STAGE_INITIAL == stage) { registries = XCHARSET_REGISTRIES (charset); if (NILP(registries)) @@ -389,7 +389,7 @@ /* #### with Xft need to handle second stage here -- sjt Hm. Or maybe not. That would be cool. :-) */ - if (stage) + if (stage == STAGE_FINAL) return Qnil; /* Fontconfig converts all FreeType names to UTF-8 before passing them @@ -683,7 +683,7 @@ switch (stage) { - case initial: + case STAGE_INITIAL: { if (!(NILP(XCHARSET_REGISTRIES(charset))) && VECTORP(XCHARSET_REGISTRIES(charset))) @@ -693,7 +693,7 @@ } break; } - case final: + case STAGE_FINAL: { registries_len = 1; registries = Qunicode_registries;
--- a/src/objects.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/objects.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,7 +1,7 @@ /* Generic Objects and Functions. Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. @@ -43,7 +43,8 @@ If we leave in the Qunbound value, we will probably get crashes. */ Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance; -/* Authors: Ben Wing, Chuck Thompson */ +/* Author: Ben Wing; some earlier code from Chuck Thompson, Jamie + Zawinski. */ DOESNT_RETURN finalose (void *ptr) @@ -845,6 +846,32 @@ #endif /* MULE */ +/* It's a little non-obvious what's going on here. Specifically: + + MATCHSPEC is a somewhat bogus way in the specifier mechanism of passing + in additional information needed to instantiate some object. For fonts, + it's a cons of (CHARSET . SECOND-STAGE-P). SECOND-STAGE-P, if set, + means "try harder to find an appropriate font" and is a very bogus way + of dealing with the fact that it may not be possible to may a charset + directly onto a font; it's used esp. under Windows. @@#### We need to + change this so that MATCHSPEC is just a character. + + When redisplay is building up its structure, and needs font info, it + calls functions in faces.c such as ensure_face_cachel_complete() (map + fonts needed for a string of text) or + ensure_face_cachel_contains_charset() (map fonts needed for a charset + derived from a single character). The former function calls the latter; + the latter calls face_property_matching_instance(); this constructs the + MATCHSPEC and calls specifier_instance_no_quit() twice (first stage and + second stage, updating MATCHSPEC appropriately). That function, in + turn, looks up the appropriate specifier method to do the instantiation, + which, lo and behold, is this function here (because we set it in + initialization using `SPECIFIER_HAS_METHOD (font, instantiate);'). We + in turn call the device method `find_charset_font', which maps to + mswindows_find_charset_font(), x_find_charset_font(), or similar, in + objects-msw.c or the like. + + --ben */ static Lisp_Object font_instantiate (Lisp_Object UNUSED (specifier), @@ -859,19 +886,20 @@ Lisp_Object instance; Lisp_Object charset = Qnil; #ifdef MULE - enum font_specifier_matchspec_stages stage = initial; + enum font_specifier_matchspec_stages stage = STAGE_INITIAL; if (!UNBOUNDP (matchspec)) { charset = Fget_charset (XCAR (matchspec)); -#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ - { \ - stage = new_stage; \ +#define FROB(new_stage, enumstage) \ + if (EQ(Q##new_stage, XCDR(matchspec))) \ + { \ + stage = enumstage; \ } - FROB(initial) - else FROB(final) + FROB (initial, STAGE_INITIAL) + else FROB (final, STAGE_FINAL) else assert(0); #undef FROB @@ -899,7 +927,8 @@ { #ifdef MULE /* #### rename these caches. */ - Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : + Lisp_Object cache = stage == STAGE_FINAL ? + d->charset_font_cache_stage_2 : d->charset_font_cache_stage_1; #else Lisp_Object cache = d->font_instance_cache; @@ -961,13 +990,13 @@ match_inst = face_property_matching_instance (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, - charset, domain, ERROR_ME, no_fallback, depth, initial); + charset, domain, ERROR_ME, no_fallback, depth, STAGE_INITIAL); if (UNBOUNDP(match_inst)) { match_inst = face_property_matching_instance (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, - charset, domain, ERROR_ME, no_fallback, depth, final); + charset, domain, ERROR_ME, no_fallback, depth, STAGE_FINAL); } return match_inst;
--- a/src/print.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/print.c Tue Feb 09 03:53:52 2010 -0600 @@ -137,7 +137,8 @@ Lisp_Object Vinhibit_quit; }; -static Lisp_Object debug_prin1_bindings; +static int begin_inhibit_non_essential_conversion_operations (void); + int stdout_needs_newline; @@ -362,10 +363,12 @@ void debug_out (const CIbyte *fmt, ...) { + int depth = begin_inhibit_non_essential_conversion_operations (); va_list args; va_start (args, fmt); write_string_to_external_output_va (fmt, args, EXT_PRINT_ALL); va_end (args); + unbind_to (depth); } DOESNT_RETURN @@ -1944,7 +1947,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; } @@ -2142,8 +2145,8 @@ if (alternate_do_pointer + extlen >= alternate_do_size) { alternate_do_size = - max(alternate_do_size * 2, alternate_do_pointer + extlen + 1); - XREALLOC_ARRAY (alternate_do_string, char, alternate_do_size); + max (alternate_do_size * 2, alternate_do_pointer + extlen + 1); + XREALLOC_ARRAY (alternate_do_string, CIbyte, alternate_do_size); } memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen); alternate_do_pointer += extlen; @@ -2260,18 +2263,38 @@ return Qnil; } +static Lisp_Object +restore_inhibit_non_essential_conversion_operations (Lisp_Object obj) +{ + inhibit_non_essential_conversion_operations = XINT (obj); + return Qnil; +} + +/* Bind the value of inhibit_non_essential_conversion_operations to 1 + in a way that involves no consing. */ +static int +begin_inhibit_non_essential_conversion_operations (void) +{ + int depth = + record_unwind_protect + (restore_inhibit_non_essential_conversion_operations, + make_int (inhibit_non_essential_conversion_operations)); + inhibit_non_essential_conversion_operations = 1; + return depth; +} + static int debug_print_length = 50; static int debug_print_level = 15; static int debug_print_readably = -1; /* Restore values temporarily bound by debug_prin1. We use this approach to - avoid consing in debug_prin1. That is verboten, since debug_prin1 can be + avoid consing in debug_prin1. That is verboten, since debug_print can be called by cons debugging code. */ static Lisp_Object -debug_prin1_exit (Lisp_Object UNUSED (ignored)) +debug_print_exit (Lisp_Object val) { - struct debug_bindings *bindings = - (struct debug_bindings *) XOPAQUE (debug_prin1_bindings)->data; + struct debug_bindings *bindings = + (struct debug_bindings *) GET_VOID_FROM_LISP (val); inhibit_non_essential_conversion_operations = bindings->inhibit_non_essential_conversion_operations; print_depth = bindings->print_depth; @@ -2285,20 +2308,18 @@ return Qnil; } -/* Print an object, `prin1'-style, to various possible debugging outputs. - Make sure it's completely unbuffered so that, in the event of a crash - somewhere, we see as much as possible that happened before it. - */ -static void -debug_prin1 (Lisp_Object debug_print_obj, int flags) +/* Save values and bind them to new values suitable for debug output. We + try very hard to avoid any Lisp allocation (i.e. consing) during the + operation of debug printing, since we might be calling it from inside GC + or other sensitive places. This means we have to be a bit careful with + record_unwind_protect to not create any temporary Lisp objects. */ + +static int +debug_print_enter (struct debug_bindings *bindings) { - /* This function can GC */ - /* by doing this, we trick various things that are non-essential but might cause crashes into not getting executed. */ int specdepth; - struct debug_bindings *bindings = - (struct debug_bindings *) XOPAQUE (debug_prin1_bindings)->data; bindings->inhibit_non_essential_conversion_operations = inhibit_non_essential_conversion_operations; @@ -2310,7 +2331,8 @@ bindings->Vprint_length = Vprint_length; bindings->Vprint_level = Vprint_level; bindings->Vinhibit_quit = Vinhibit_quit; - specdepth = record_unwind_protect (debug_prin1_exit, Qnil); + specdepth = record_unwind_protect (debug_print_exit, + STORE_VOID_IN_LISP (bindings)); inhibit_non_essential_conversion_operations = 1; print_depth = 0; @@ -2324,6 +2346,20 @@ Vprint_level = make_int (debug_print_level); Vinhibit_quit = Qt; + return specdepth; +} + +/* Print an object, `prin1'-style, to various possible debugging outputs. + Make sure it's completely unbuffered so that, in the event of a crash + somewhere, we see as much as possible that happened before it. + */ +static void +debug_prin1 (Lisp_Object debug_print_obj, int flags) +{ + /* This function cannot GC, since GC is forbidden */ + struct debug_bindings bindings; + int specdepth = debug_print_enter (&bindings); + if ((flags & EXT_PRINT_STDOUT) || (flags & EXT_PRINT_STDERR)) print_internal (debug_print_obj, Qexternal_debugging_output, 1); if (flags & EXT_PRINT_ALTERNATE) @@ -2342,7 +2378,6 @@ void debug_p4 (Lisp_Object obj) { - inhibit_non_essential_conversion_operations = 1; if (STRINGP (obj)) debug_out ("\"%s\"", XSTRING_DATA (obj)); else if (CONSP (obj)) @@ -2416,42 +2451,41 @@ ((struct old_lcrecord_header *) header)->uid)); #endif /* not NEW_GC */ } - - inhibit_non_essential_conversion_operations = 0; } -static void +static int ext_print_begin (int dest) { + int depth = begin_inhibit_non_essential_conversion_operations (); if (dest & EXT_PRINT_ALTERNATE) alternate_do_pointer = 0; if (dest & (EXT_PRINT_STDERR | EXT_PRINT_STDOUT)) stdout_clear_before_next_output = 1; + return depth; } static void -ext_print_end (int dest) +ext_print_end (int dest, int depth) { if (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR | EXT_PRINT_STDOUT)) external_out (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR | EXT_PRINT_STDOUT), "\n"); + unbind_to (depth); } static void external_debug_print (Lisp_Object object, int dest) { - ext_print_begin (dest); + int depth = ext_print_begin (dest); debug_prin1 (object, dest); - ext_print_end (dest); + ext_print_end (dest, depth); } void debug_p3 (Lisp_Object obj) { debug_p4 (obj); - inhibit_non_essential_conversion_operations = 1; debug_out ("\n"); - inhibit_non_essential_conversion_operations = 0; } void @@ -2483,22 +2517,9 @@ void debug_backtrace (void) { - /* This function can GC */ - - /* by doing this, we trick various things that are non-essential - but might cause crashes into not getting executed. */ - int specdepth = - internal_bind_int (&inhibit_non_essential_conversion_operations, 1); - - internal_bind_int (&print_depth, 0); - internal_bind_int (&print_readably, 0); - internal_bind_int (&print_unbuffered, print_unbuffered + 1); - if (debug_print_length > 0) - internal_bind_lisp_object (&Vprint_length, make_int (debug_print_length)); - if (debug_print_level > 0) - internal_bind_lisp_object (&Vprint_level, make_int (debug_print_level)); - /* #### Do we need this? It was in the old code. */ - internal_bind_lisp_object (&Vinhibit_quit, Vinhibit_quit); + /* This function cannot GC, since GC is forbidden */ + struct debug_bindings bindings; + int specdepth = debug_print_enter (&bindings); Fbacktrace (Qexternal_debugging_output, Qt); stderr_out ("\n"); @@ -2519,6 +2540,7 @@ { int first = 1; struct backtrace *bt = backtrace_list; + debug_out (" ["); while (length > 0 && bt) { @@ -2698,10 +2720,9 @@ */ ); Vprint_message_label = Qprint; - debug_prin1_bindings = - make_opaque (OPAQUE_UNINIT, sizeof (struct debug_bindings)); - staticpro (&debug_prin1_bindings); - + /* The exact size doesn't matter since we realloc when necessary. + Use CIbyte instead of Ibyte so that debuggers show the associated + string automatically. */ alternate_do_size = 5000; - alternate_do_string = xnew_array(char, 5000); + alternate_do_string = xnew_array (CIbyte, 5000); }
--- a/src/process-unix.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/process-unix.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/process.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/profile.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/scrollbar-msw.c Tue Feb 09 03:53:52 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/search.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/search.c Tue Feb 09 03:53:52 2010 -0600 @@ -1437,13 +1437,13 @@ is not involved--but this is not a critical issue. */ Ibyte encoded[MAX_ICHAR_LEN]; - Bytecount len = set_itext_ichar (encoded, c); - int i, j; - for (i = 0; i < len && boyer_moore_ok; ++i) + Bytecount clen = set_itext_ichar (encoded, c); + int a, b; + for (a = 0; a < clen && boyer_moore_ok; ++a) { - for (j = i + 1; j < len && boyer_moore_ok; ++j) + for (b = a + 1; b < clen && boyer_moore_ok; ++b) { - if (encoded[i] == encoded[j]) + if (encoded[a] == encoded[b]) { boyer_moore_ok = 0; }
--- a/src/signal.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/signal.c Tue Feb 09 03:53:52 2010 -0600 @@ -444,6 +444,11 @@ #endif something_happened = 0; + /* Don't try to do anything clever if we're called from debug_print() + or very close to startup or shutdown. */ + if (inhibit_non_essential_conversion_operations) + return; + if (async_timeout_happened) { async_timeout_happened = 0;
--- a/src/specifier.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/specifier.c Tue Feb 09 03:53:52 2010 -0600 @@ -1,6 +1,6 @@ /* Specifier implementation Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2005, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs. @@ -33,6 +33,7 @@ #include "buffer.h" #include "chartab.h" #include "device-impl.h" +#include "elhash.h" #include "frame.h" #include "glyphs.h" #include "opaque.h" @@ -47,6 +48,14 @@ Lisp_Object Qconsole_type, Qdevice_class; static Lisp_Object Vuser_defined_tags; +/* This is a hash table mapping charsets to "tag lists". A tag list here + is an assoc list mapping charset tags to size-two vectors (one for the + initial stage, one for the final stage) containing t or nil, indicating + whether the charset tag matches the charset for the given stage. These + values are determined at the time a charset tag is defined by calling + the charset predicate on all the existing charsets, and at the time a + charset is defined by calling the predicate on all existing charset + tags. */ static Lisp_Object Vcharset_tag_lists; typedef struct specifier_type_entry specifier_type_entry; @@ -982,46 +991,42 @@ } static int -charset_matches_specifier_tag_set_p (Lisp_Object USED_IF_MULE (charset), - Lisp_Object tag_set, +charset_matches_specifier_tag_set_p (Lisp_Object charset, Lisp_Object tag_set, enum font_specifier_matchspec_stages stage) { Lisp_Object rest; int res = 0; - assert(stage != impossible); + assert(stage < NUM_MATCHSPEC_STAGES); LIST_LOOP (rest, tag_set) { Lisp_Object tag = XCAR (rest); Lisp_Object assoc; + Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil); /* In the event that, during the creation of a charset, no specifier tags exist for which CHARSET-PREDICATE has been specified, then that charset's entry in Vcharset_tag_lists will be nil, and this charset shouldn't match. */ - if (NILP (XVECTOR_DATA(Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - - MIN_LEADING_BYTE])) + if (NILP (tag_list)) { return 0; } /* Now, find out what the pre-calculated value is. */ - assoc = assq_no_quit(tag, - XVECTOR_DATA(Vcharset_tag_lists) - [XCHARSET_LEADING_BYTE(charset) - - MIN_LEADING_BYTE]); - - if (!(NILP(assoc)) && !(NILP(XCDR(assoc)))) + assoc = assq_no_quit (tag, tag_list); + + if (!(NILP (assoc))) { - assert(VECTORP(XCDR(assoc))); + assert (VECTORP (XCDR (assoc))); /* In the event that a tag specifies a charset, then the specifier must match for (this stage and this charset) for all charset-specifying tags. */ - if (NILP(XVECTOR_DATA(XCDR(assoc))[stage])) + if (NILP (XVECTOR_DATA (XCDR (assoc))[stage])) { /* It doesn't match for this tag, even though the tag specifies a charset. Return 0. */ @@ -1059,13 +1064,65 @@ return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil; } +/* Call CHARSET_PREDICATE on CHARSET, evaluating it at both stages (initial + and final) and returning a size-two vector of the results. */ + +static Lisp_Object +call_charset_predicate (Lisp_Object charset_predicate, Lisp_Object charset) +{ + struct gcpro gcpro1; + Lisp_Object charpres = make_vector (NUM_MATCHSPEC_STAGES, Qnil); + int max_args = XINT (Ffunction_max_args (charset_predicate)); + GCPRO1 (charpres); + + +#define DEFINE_SPECIFIER_TAG_FROB(stage, enumstage) \ + do { \ + if (max_args > 1) \ + { \ + XVECTOR_DATA (charpres)[enumstage] = \ + call2_trapping_problems \ + ("Error during specifier tag charset predicate," \ + " stage " #stage, charset_predicate, \ + charset, Q##stage, 0); \ + } \ + else \ + { \ + XVECTOR_DATA (charpres)[enumstage] = \ + call1_trapping_problems \ + ("Error during specifier tag charset predicate," \ + " stage " #stage, charset_predicate, \ + charset, 0); \ + } \ + \ + if (UNBOUNDP (XVECTOR_DATA (charpres)[enumstage])) \ + { \ + XVECTOR_DATA (charpres)[enumstage] = Qnil; \ + } \ + else if (!NILP (XVECTOR_DATA (charpres)[enumstage])) \ + { \ + /* Don't want refs to random other objects. */ \ + XVECTOR_DATA (charpres)[enumstage] = Qt; \ + } \ + } while (0) + + DEFINE_SPECIFIER_TAG_FROB (initial, STAGE_INITIAL); + DEFINE_SPECIFIER_TAG_FROB (final, STAGE_FINAL); + +#undef DEFINE_SPECIFIER_TAG_FROB + + UNGCPRO; + + return charpres; +} + Lisp_Object -define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate, - Lisp_Object charset_predicate) +define_specifier_tag (Lisp_Object tag, Lisp_Object device_predicate, + Lisp_Object charset_predicate) { Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags), - concons, devcons, charpres = Qnil; - int recompute_devices = 0, recompute_charsets = 0, i, max_args = -1; + concons, devcons; + int recompute_devices = 0, recompute_charsets = 0; if (NILP (assoc)) { @@ -1081,31 +1138,14 @@ DEVICE_USER_DEFINED_TAGS (d) = Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d)); } - - if (!NILP (charset_predicate)) - { - max_args = XINT(Ffunction_max_args(charset_predicate)); - if (max_args < 1) - { - invalid_argument - ("Charset predicate must be able to take an argument", tag); - } - } } else if (!NILP (device_predicate) && !NILP (XCADR (assoc))) { recompute_devices = 1; - XCDR (assoc) = list2(device_predicate, charset_predicate); + XCDR (assoc) = list2 (device_predicate, charset_predicate); } - else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc))) + else if (!NILP (charset_predicate) || !NILP (XCADDR (assoc))) { - max_args = XINT(Ffunction_max_args(charset_predicate)); - if (max_args < 1) - { - invalid_argument - ("Charset predicate must be able to take an argument", tag); - } - /* If there exists a charset_predicate for the tag currently (even if the new charset_predicate is nil), or if we're adding one, we need to recompute. This contrasts with the device predicates, where we @@ -1113,7 +1153,7 @@ both nil. */ recompute_charsets = 1; - XCDR (assoc) = list2(device_predicate, charset_predicate); + XCDR (assoc) = list2 (device_predicate, charset_predicate); } /* Recompute the tag values for all devices and charsets, if necessary. In @@ -1141,80 +1181,28 @@ if (recompute_charsets) { - if (NILP(charset_predicate)) - { - charpres = Qnil; - } - - for (i = 0; i < NUM_LEADING_BYTES; ++i) + + LIST_LOOP_2 (charset_name, Fcharset_list ()) { - if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i))) - { - continue; - } - - assoc = assq_no_quit (tag, - XVECTOR_DATA(Vcharset_tag_lists)[i]); - - if (!NILP(charset_predicate)) + Lisp_Object charset = Fget_charset (charset_name); + Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil); + Lisp_Object charpres; + + if (NILP (charset_predicate)) + continue; + + charpres = call_charset_predicate (charset_predicate, charset); + + assoc = assq_no_quit (tag, tag_list); + if (!NILP (assoc)) { - struct gcpro gcpro1; - charpres = make_vector(impossible, Qnil); - GCPRO1 (charpres); - - /* If you want to extend the number of stages available, here - in setup_charset_initial_specifier_tags, and in specifier.h - is where you want to go. */ - -#define DEFINE_SPECIFIER_TAG_FROB(stage) do { \ - if (max_args > 1) \ - { \ - XVECTOR_DATA(charpres)[stage] = \ - call2_trapping_problems \ - ("Error during specifier tag charset predicate," \ - " stage " #stage, charset_predicate, \ - charset_by_leading_byte(MIN_LEADING_BYTE + i), \ - Q##stage, 0); \ - } \ - else \ - { \ - XVECTOR_DATA(charpres)[stage] = \ - call1_trapping_problems \ - ("Error during specifier tag charset predicate," \ - " stage " #stage, charset_predicate, \ - charset_by_leading_byte(MIN_LEADING_BYTE + i), \ - 0); \ - } \ - \ - if (UNBOUNDP(XVECTOR_DATA(charpres)[stage])) \ - { \ - XVECTOR_DATA(charpres)[stage] = Qnil; \ - } \ - else if (!NILP(XVECTOR_DATA(charpres)[stage])) \ - { \ - /* Don't want refs to random other objects. */ \ - XVECTOR_DATA(charpres)[stage] = Qt; \ - } \ - } while (0) - - DEFINE_SPECIFIER_TAG_FROB (initial); - DEFINE_SPECIFIER_TAG_FROB (final); - -#undef DEFINE_SPECIFIER_TAG_FROB - - UNGCPRO; - } - - if (!NILP(assoc)) - { - assert(CONSP(assoc)); + assert (CONSP (assoc)); XCDR (assoc) = charpres; } else { - XVECTOR_DATA(Vcharset_tag_lists)[i] - = Fcons(Fcons(tag, charpres), - XVECTOR_DATA (Vcharset_tag_lists)[i]); + Fputhash (charset, Fcons (Fcons (tag, charpres), tag_list), + Vcharset_tag_lists); } } } @@ -1259,8 +1247,6 @@ */ (tag, device_predicate, charset_predicate)) { - int max_args; - CHECK_SYMBOL (tag); if (valid_device_class_p (tag) || valid_console_type_p (tag) || @@ -1273,8 +1259,10 @@ if (!NILP (charset_predicate)) { - max_args = XINT(Ffunction_max_args(charset_predicate)); - if (max_args != 1) + Lisp_Object min_args = Ffunction_min_args (charset_predicate); + Lisp_Object max_args = Ffunction_max_args (charset_predicate); + if (!(INTP (min_args) && XINT (min_args) == 1 && + INTP (max_args) && XINT (max_args) == 1)) { /* We only allow the stage argument to be specifed from C. */ invalid_change ("Charset predicate must take one argument", @@ -1333,47 +1321,19 @@ LIST_LOOP (rest, Vuser_defined_tags) { - tag = XCAR(XCAR(rest)); - charset_predicate = XCADDR(XCAR (rest)); - - if (NILP(charset_predicate)) + tag = XCAR (XCAR (rest)); + charset_predicate = XCADDR (XCAR (rest)); + + if (NILP (charset_predicate)) { continue; } - new_value = make_vector(impossible, Qnil); - -#define SETUP_CHARSET_TAGS_FROB(stage) do { \ - \ - XVECTOR_DATA(new_value)[stage] = call2_trapping_problems \ - ("Error during specifier tag charset predicate," \ - " stage " #stage, \ - charset_predicate, charset, Q##stage, 0); \ - \ - if (UNBOUNDP(XVECTOR_DATA(new_value)[stage])) \ - { \ - XVECTOR_DATA(new_value)[stage] = Qnil; \ - } \ - else if (!NILP(XVECTOR_DATA(new_value)[stage])) \ - { \ - /* Don't want random other objects hanging around. */ \ - XVECTOR_DATA(new_value)[stage] = Qt; \ - } \ - \ - } while (0) - - SETUP_CHARSET_TAGS_FROB (initial); - SETUP_CHARSET_TAGS_FROB (final); - /* More later? */ - -#undef SETUP_CHARSET_TAGS_FROB - - charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list); + new_value = call_charset_predicate (charset_predicate, charset); + charset_tag_list = Fcons (Fcons (tag, new_value), charset_tag_list); } - XVECTOR_DATA - (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE] - = charset_tag_list; + Fputhash (charset, charset_tag_list, Vcharset_tag_lists); } /* VM calls this, in vm-multiple-frames-possible-p, in the event that you're @@ -2812,7 +2772,7 @@ Lisp_Object device, charset = Qnil, rest; int count = specpdl_depth (), respected_charsets = 0; struct gcpro gcpro1, gcpro2; - enum font_specifier_matchspec_stages stage = initial; + enum font_specifier_matchspec_stages stage = STAGE_INITIAL; GCPRO2 (specifier, inst_list); @@ -2829,9 +2789,9 @@ #ifdef MULE /* #### FIXME Does this font-specific stuff need to be here and not in the font-specifier-specific code? --ben */ - if (CONSP(matchspec) && (CHARSETP(Ffind_charset(XCAR(matchspec))))) + if (CONSP (matchspec) && (CHARSETP (Ffind_charset (XCAR (matchspec))))) { - charset = Ffind_charset(XCAR(matchspec)); + charset = Ffind_charset (XCAR (matchspec)); #ifdef DEBUG_XEMACS /* This is mostly to have somewhere to set debug breakpoints. */ @@ -2841,16 +2801,17 @@ } #endif /* DEBUG_XEMACS */ - if (!NILP(XCDR(matchspec))) + if (!NILP (XCDR (matchspec))) { -#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ - { \ - stage = new_stage; \ +#define FROB(new_stage, enumstage) \ + if (EQ (Q##new_stage, XCDR (matchspec))) \ + { \ + stage = enumstage; \ } - FROB(initial) - else FROB(final) + FROB (initial, STAGE_INITIAL) + else FROB (final, STAGE_FINAL) else assert(0); #undef FROB @@ -3548,7 +3509,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 +3529,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) @@ -3923,6 +3884,7 @@ Vunlock_ghost_specifiers = Qnil; staticpro (&Vunlock_ghost_specifiers); - Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil); + Vcharset_tag_lists = + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); staticpro (&Vcharset_tag_lists); }
--- a/src/specifier.h Mon Feb 08 20:45:21 2010 -0500 +++ b/src/specifier.h Tue Feb 09 03:53:52 2010 -0600 @@ -572,16 +572,6 @@ #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table) #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table) -/* The various stages of font instantiation; initial means "find a font for - CHARSET that matches the charset's registries" and final means "find a - font for CHARSET that matches iso10646-1, since we haven't found a font - that matches its registry." */ -enum font_specifier_matchspec_stages { - initial, - final, - impossible, -}; - Lisp_Object define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate, Lisp_Object charset_predicate);
--- a/src/strftime.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/strftime.c Tue Feb 09 03:53:52 2010 -0600 @@ -396,13 +396,13 @@ case 'G': { int year = tm->tm_year + 1900; - int days = iso_week_days (tm->tm_yday, tm->tm_wday); + int ndays = iso_week_days (tm->tm_yday, tm->tm_wday); - if (days < 0) + if (ndays < 0) { /* This ISO week belongs to the previous year. */ year--; - days = + ndays = iso_week_days (tm->tm_yday + (365 + __isleap (year)), tm->tm_wday); } @@ -415,7 +415,7 @@ { /* This ISO week belongs to the next year. */ year++; - days = d; + ndays = d; } } @@ -442,7 +442,7 @@ default: length += - add_num2 (&string[length], days / 7 + 1, + add_num2 (&string[length], ndays / 7 + 1, max - length, pad); break; } @@ -474,7 +474,7 @@ /* tm diff code below is based on mktime.c, glibc 2.3.2 */ { int lt4, ut4, lt100, ut100, lt400, ut400; - int intervening_leap_days, years, days; + int intervening_leap_days, years, ndays; lt4 = (lt.tm_year >> 2) + (1900 >> 2) - ! (lt.tm_year & 3); @@ -487,9 +487,10 @@ intervening_leap_days = (lt4 - ut4) - (lt100 - ut100) + (lt400 - ut400); years = lt.tm_year - ut->tm_year; - days = (365 * years + intervening_leap_days + ndays = (365 * years + intervening_leap_days + (lt.tm_yday - ut->tm_yday)); - offset = (60 * (60 * (24 * days + (lt.tm_hour - ut->tm_hour)) + offset = (60 * (60 * (24 * ndays + + (lt.tm_hour - ut->tm_hour)) + (lt.tm_min - ut->tm_min)) + (lt.tm_sec - ut->tm_sec)); }
--- a/src/syntax.c Mon Feb 08 20:45:21 2010 -0500 +++ b/src/syntax.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/tests.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/text.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/text.h Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/tooltalk.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/ui-byhand.c Tue Feb 09 03:53:52 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 20:45:21 2010 -0500 +++ b/src/ui-gtk.c Tue Feb 09 03:53:52 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 */