Mercurial > hg > xemacs-beta
changeset 5027:22179cd0fe15
merge
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 10 Feb 2010 07:25:19 -0600 |
| parents | 46cf825f6158 (current diff) 680ca8de98a3 (diff) |
| children | acf7d1bc0490 efaa6cd845e5 |
| files | src/ChangeLog src/text.h |
| diffstat | 79 files changed, 1548 insertions(+), 921 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Wed Feb 10 07:15:36 2010 -0600 +++ b/ChangeLog Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/configure Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/configure.ac Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/ChangeLog Wed Feb 10 07:25:19 2010 -0600 @@ -1,3 +1,29 @@ +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 + definition, now we check the symbol is bound in fileio.c + * version.el (format-decode): Ditto. + * format.el (car-less-than-car, cdr-less-than-cdr): Move these + here from fileio.c, now they are only called once format.el is + available. + +2010-02-07 Aidan Kehoe <kehoea@parhasard.net> + + * setup-paths.el (paths-find-emacs-roots) + (paths-construct-info-path): + * packages.el (packages-find-installation-package-directories): + #'union doesn't guarantee that it will preserve the relative order + of elements in its arguments; use #'delete-duplicates + instead. Thank you for the bug reports, Robert Pluim, Stephen + Turnbull. + 2010-02-06 Ben Wing <ben@xemacs.org> * unicode.el:
--- a/lisp/help.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/help.el Wed Feb 10 07:25:19 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/lisp/make-docfile.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/make-docfile.el Wed Feb 10 07:25:19 2010 -0600 @@ -78,11 +78,6 @@ ;; (message (concat "Options: " (prin1-to-string options))) -;; insert-file-contents-internal calls out to `format-decode' afterwards, -;; so it must be defined. if non-zero, it tries to do a bunch more stuff -;; so say, "NOOOOOOOOOOOOO! Basta! Ca soufit! Enough, already, OK?" -(defun format-decode (fuck me harder) 0) - ;; Next process the list of C files. (defun process-args (args) (while args
--- a/lisp/packages.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/packages.el Wed Feb 10 07:25:19 2010 -0600 @@ -385,8 +385,10 @@ (defun packages-find-installation-package-directories (roots) "Find the package directories in the XEmacs installation. ROOTS is a list of installation roots." - (union (paths-find-version-directories roots (list "") nil nil nil t) - (paths-find-site-directories roots (list "") nil) :test #'equal)) + (delete-duplicates + (nconc (paths-find-version-directories roots (list "") nil nil nil t) + (paths-find-site-directories roots (list "") nil)) + :test #'equal)) (defun packages-find-package-hierarchies (package-directories &optional envvar default) "Find package hierarchies in a list of package directories.
--- a/lisp/setup-paths.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/setup-paths.el Wed Feb 10 07:25:19 2010 -0600 @@ -142,17 +142,19 @@ invocation-name root-p)) (potential-installation-roots - (union - (and configure-exec-prefix-directory - (list (file-name-as-directory - configure-exec-prefix-directory))) - (and configure-prefix-directory - (list (file-name-as-directory - configure-prefix-directory))) + (delete-duplicates + (append + (and configure-exec-prefix-directory + (list (file-name-as-directory + configure-exec-prefix-directory))) + (and configure-prefix-directory + (list (file-name-as-directory + configure-prefix-directory)))) :test #'equal)) (installation-roots (remove-if-not root-p potential-installation-roots))) - (union invocation-roots installation-roots :test #'equal))) + (delete-duplicates (nconc invocation-roots installation-roots) + :test #'equal))) (defun paths-find-site-lisp-directory (roots) "Find the site Lisp directory of the XEmacs hierarchy. @@ -260,24 +262,26 @@ LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, respectively." (let ((info-path-envval (getenv "INFOPATH"))) - (union - (append - (let ((info-directory - (paths-find-version-directory roots (list "info") - nil nil - configure-info-directory))) - (and info-directory - (list info-directory))) - (packages-find-package-info-path early-package-hierarchies) - (packages-find-package-info-path late-package-hierarchies) - (packages-find-package-info-path last-package-hierarchies) - (and info-path-envval - (paths-decode-directory-path info-path-envval 'drop-empties))) - (and (null info-path-envval) - (union - (paths-directories-which-exist configure-info-path) - (paths-directories-which-exist paths-default-info-directories) - :test #'equal)) + (delete-duplicates + (nconc + (append + (let ((info-directory + (paths-find-version-directory roots (list "info") + nil nil + configure-info-directory))) + (and info-directory + (list info-directory))) + (packages-find-package-info-path early-package-hierarchies) + (packages-find-package-info-path late-package-hierarchies) + (packages-find-package-info-path last-package-hierarchies) + (and info-path-envval + (paths-decode-directory-path info-path-envval 'drop-empties))) + (and (null info-path-envval) + (delete-duplicates + (nconc + (paths-directories-which-exist configure-info-path) + (paths-directories-which-exist paths-default-info-directories)) + :test #'equal))) :test #'equal))) (defun paths-find-doc-directory (roots)
--- a/lisp/subr.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/subr.el Wed Feb 10 07:25:19 2010 -0600 @@ -1777,4 +1777,19 @@ 'many) (t (subr-max-args subr))))) +;; XEmacs; move these here from C. Would be nice to drop them entirely, but +;; they're used reasonably often, since they've been around for a long time +;; and they're portable to GNU. + +;; Used in fileio.c if format-annotate-function has a function binding +;; (which it won't have before this file is loaded): +(defun car-less-than-car (a b) + "Return t if the car of A is numerically less than the car of B." + (< (car a) (car b))) + +;; Used in packages. +(defun cdr-less-than-cdr (a b) + "Return t if (cdr A) is numerically less than (cdr B)." + (< (cdr a) (cdr b))) + ;;; subr.el ends here
--- a/lisp/version.el Wed Feb 10 07:15:36 2010 -0600 +++ b/lisp/version.el Wed Feb 10 07:25:19 2010 -0600 @@ -152,9 +152,6 @@ (save-current-buffer (set-buffer (get-buffer-create (generate-new-buffer-name " *temp*"))) - ;; insert-file-contents-internal bogusly calls - ;; format-decode without checking if it's defined. - (fset 'format-decode #'(lambda (f l &optional v) l)) (insert-file-contents-internal (expand-file-name "Installation" build-directory) ;; Relies on our working out the system coding system @@ -164,7 +161,6 @@ ;; mule/general-late.el, after all the dumped coding systems have been ;; loaded. 'binary) - (fmakunbound 'format-decode) (prog1 (buffer-substring) (kill-buffer (current-buffer)))) "Description of XEmacs installation. @@ -175,4 +171,4 @@ occasionally used, in a way the XEmacs developers don't endorse, to work out version information. ") -;;; version.el ends here \ No newline at end of file +;;; version.el ends here
--- a/lwlib/ChangeLog Wed Feb 10 07:15:36 2010 -0600 +++ b/lwlib/ChangeLog Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/lwlib/xt-wrappers.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/man/ChangeLog Wed Feb 10 07:25:19 2010 -0600 @@ -1,3 +1,15 @@ +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-08 Jerry James <james@xemacs.org> + + * emodules.texi: Relicense as GPL v2 or later, using J. Kean + Johnston's blanket permission for such relicensing of his works. + 2010-02-05 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules):
--- a/man/emodules.texi Wed Feb 10 07:15:36 2010 -0600 +++ b/man/emodules.texi Wed Feb 10 07:25:19 2010 -0600 @@ -32,6 +32,8 @@ @set emacs XEmacs @end ifclear +@c TODO: Merge the info-only and TeX-only license text, since they are +@c identical. @ifinfo This file documents the module loading technology of @value{emacs}. @@ -41,35 +43,22 @@ manual provided the copyright notice and this permission notice are preserved on all copies. -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission notice -identical to this one except for the removal of this paragraph (this -paragraph not being relevant to the printed manual). +This file is part of XEmacs. -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the Foundation. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``GNU General Public License'' is included exactly as -in the original, and provided that the entire resulting derived work is -distributed under the terms of a permission notice identical to this -one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, +Boston, MA 02110-1301, USA. @end ifinfo @c Combine indices. @@ -97,22 +86,22 @@ Version 1.0 @* September, 1998.@* -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``GNU General Public License'' is included -exactly as in the original, and provided that the entire resulting -derived work is distributed under the terms of a permission notice -identical to this one. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, +Boston, MA 02110-1301, USA. @end titlepage @page
--- a/man/internals/internals.texi Wed Feb 10 07:15:36 2010 -0600 +++ b/man/internals/internals.texi Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/ChangeLog Wed Feb 10 07:25:19 2010 -0600 @@ -14,6 +14,381 @@ (2) Reformat the macros in text.h so they line up properly. +2010-02-09 Jerry James <james@xemacs.org> + + * s/hpux11-shr.h: Add license information from Marcus Thiessel. + +2010-02-09 Ben Wing <ben@xemacs.org> + + * dynarr.c (Dynarr_insert_many): + * dynarr.c (Dynarr_delete_many): + * emacs.c: + * emacs.c (pause_so_user_can_read_messages): + * emacs.c (Fkill_emacs): + * emacs.c (guts_of_fatal_error_signal): + * lisp.h: + * lisp.h (INLINE_ERROR_CHECK_ARGS): + * lisp.h (Dynarr_set_length_1): + * lisp.h (Dynarr_set_length): + * lisp.h (Dynarr_pop): + Add ERROR_CHECK_DYNARR, dynarr_checking_assert(). Use it. + Sort existing error-check categories in lisp.h, remove most of the + (unused) assert variations from most categories. Add a long + comment about reorganizing the system by categories and + subcategories. Create ERROR_CHECK_ANY if any error-checking + categories defined, and use it in emacs.c to define + USER_IS_DEVELOPING_XEMACS. + + In emacs.c and cmdloop.c, don't display a message at early + shutdown or fatal shutdown when on Cygwin, only Windows native -- + Cygwin has a working stderr that shows error output. + + Update comment in Dynarr_verify_pos_atp(). + + +2010-02-09 Ben Wing <ben@xemacs.org> + + * syswindows.h: + Create a long comment about build flags such as WIN32_NATIVE, + HAVE_MS_WINDOWS. + +2010-02-09 Ben Wing <ben@xemacs.org> + + * lisp.h: + Disabled inline assert should just use disabled_assert() + not disabled_assert_at_line() otherwise you get compile errors. + (Hasn't bitten us only because no one is currently using inline + asserts -- but this is different in the Unicode-internal repo.) + +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-09 Vin Shelton <acs@xemacs.org> + + * objects-msw.c (mswindows_font_spec_matches_charset_stage_2): + Declare hfont at start of a code block. + + * glyphs-eimage.c: Undefine and then redefine FAR around the jpeg + header. + +2010-02-08 Vin Shelton <acs@xemacs.org> + + * nt.c (open_unc_volume): lpRemoteName is an XELPTSTR. + +2010-02-07 Aidan Kehoe <kehoea@parhasard.net> + + * lisp.h (Dynarr_verify, Dynarr_verify_mod): + If ERROR_CHECK_STRUCTURES is not defined, cast the argument in + these two macros; fixes the g++ build. + +2010-02-07 Aidan Kehoe <kehoea@parhasard.net> + + * fileio.c (Finsert_file_contents_internal): + Only call format-decode if it has a function binding. + (build_annotations): Only call format-annotate-function if it has + a function binding; incidentally only calling #'car-less-than-car + if *it* has a function binding. + (syms_of_fileio): #'car-less-than-car and #'cdr-less-than-cdr are + now in Lisp. + 2010-02-07 Ben Wing <ben@xemacs.org> * fns.c: Qlist, Qstring mistakenly declared twice.
--- a/src/alloc.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/alloc.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/casetab.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/charset.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/chartab.c Wed Feb 10 07:25:19 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/cmdloop.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/cmdloop.c Wed Feb 10 07:25:19 2010 -0600 @@ -161,7 +161,8 @@ Fforce_debugging_signal (Qt); } #endif -#ifdef HAVE_MS_WINDOWS +#if defined (HAVE_MS_WINDOWS) && defined (WIN32_NATIVE) + /* Don't do this under Cygwin, since we have output on stderr. */ Fmswindows_message_box (build_msg_string ("Initialization error"), Qnil, Qnil); #endif
--- a/src/console-x.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/console-x.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/console-x.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/console.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/depend Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/device.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/dialog-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/dialog-x.c Wed Feb 10 07:25:19 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/dynarr.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/dynarr.c Wed Feb 10 07:25:19 2010 -0600 @@ -245,7 +245,7 @@ /* #### This could conceivably be wrong, if code wants to access stuff between len and largest. */ - structure_checking_assert (start >= 0 && start <= Dynarr_length (dy)); + dynarr_checking_assert (start >= 0 && start <= Dynarr_length (dy)); if (start != Dynarr_length (dy)) { @@ -267,8 +267,8 @@ { Dynarr *dy = Dynarr_verify_mod (d); - structure_checking_assert (start >= 0 && len >= 0 && - start + len <= Dynarr_length (dy)); + dynarr_checking_assert (start >= 0 && len >= 0 && + start + len <= Dynarr_length (dy)); memmove ((char *) dy->base + start*dy->elsize, (char *) dy->base + (start + len)*dy->elsize,
--- a/src/emacs.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/emacs.c Wed Feb 10 07:25:19 2010 -0600 @@ -2,7 +2,7 @@ Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. @@ -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; @@ -3331,6 +3334,21 @@ /* exiting XEmacs (intended or not) */ /************************************************************************/ +/* Do we need to pause with a message box so that messages can be read + at shutdown? We do this is we have support for native Windows frames + and if we are native Windows. The first part is because only when compiled + for native Windows frames do we have Fmswindows_message_box(), and + the second part is because we don't want to do this under Cygwin, where + we have a Unix-like environment and a working stderr where the messages + go. The two conditions sound somewhat redundant (maybe we could just + use the second?) but they aren't completely: Theoretically (maybe with + MinGW?) we could imagine compiling under native Windows as the OS + but e.g. targetting only X Windows as the window system. --ben */ + +#if defined (HAVE_MS_WINDOWS) && defined (WIN32_NATIVE) +# define NEED_WINDOWS_MESSAGE_PAUSE +#endif + /* Info on intended/unintended exits: @@ -3465,7 +3483,7 @@ Vquit_flag = Qnil; } -#ifdef HAVE_MS_WINDOWS +#ifdef NEED_WINDOWS_MESSAGE_PAUSE static void pause_so_user_can_read_messages (int allow_further) { @@ -3716,7 +3734,7 @@ UNGCPRO; -#ifdef HAVE_MS_WINDOWS +#ifdef NEED_WINDOWS_MESSAGE_PAUSE pause_so_user_can_read_messages (1); #endif @@ -3752,7 +3770,7 @@ loops will fight each other and the return key will never be passed to the "pause" handler so that XEmacs's GPF handler can return, resignal the GPF, and properly go into the debugger.) */ -#if defined (ERROR_CHECK_TYPES) || defined (ERROR_CHECK_TEXT) || defined (ERROR_CHECK_GC) || defined (ERROR_CHECK_STRUCTURES) +#ifdef ERROR_CHECK_ANY #define USER_IS_DEVELOPING_XEMACS #endif @@ -3808,7 +3826,7 @@ } } # endif -#if defined (HAVE_MS_WINDOWS) && !defined (USER_IS_DEVELOPING_XEMACS) +#if defined (NEED_WINDOWS_MESSAGE_PAUSE) && !defined (USER_IS_DEVELOPING_XEMACS) pause_so_user_can_read_messages (0); #endif } @@ -3967,7 +3985,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 +4053,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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/eval.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/event-Xt.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/event-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/event-unixoid.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/faces.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/faces.h Wed Feb 10 07:25:19 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/fileio.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/fileio.c Wed Feb 10 07:25:19 2010 -0600 @@ -3268,10 +3268,10 @@ } /* Decode file format */ - if (inserted > 0) + if (inserted > 0 && !UNBOUNDP (XSYMBOL_FUNCTION (Qformat_decode))) { - Lisp_Object insval = call3 (Qformat_decode, - Qnil, make_int (inserted), visit); + Lisp_Object insval = call3 (Qformat_decode, Qnil, make_int (inserted), + visit); CHECK_INT (insval); inserted = XINT (insval); } @@ -3628,33 +3628,6 @@ return Qnil; } -/* #### This is such a load of shit!!!! There is no way we should define - something so stupid as a subr, just sort the fucking list more - intelligently. */ -DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /* -Return t if (car A) is numerically less than (car B). -*/ - (a, b)) -{ - Lisp_Object objs[2]; - objs[0] = Fcar (a); - objs[1] = Fcar (b); - return Flss (2, objs); -} - -/* Heh heh heh, let's define this too, just to aggravate the person who - wrote the above comment. */ -DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /* -Return t if (cdr A) is numerically less than (cdr B). -*/ - (a, b)) -{ - Lisp_Object objs[2]; - objs[0] = Fcdr (a); - objs[1] = Fcdr (b); - return Flss (2, objs); -} - /* Build the complete list of annotations appropriate for writing out the text between START and END, by calling all the functions in write-region-annotate-functions and merging the lists they return. @@ -3698,10 +3671,19 @@ } /* Now do the same for annotation functions implied by the file-format */ - if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) - p = Vauto_save_file_format; + if (UNBOUNDP (XSYMBOL_FUNCTION (Qformat_annotate_function))) + { + p = Qnil; + } + else if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) + { + p = Vauto_save_file_format; + } else - p = current_buffer->file_format; + { + p = current_buffer->file_format; + } + while (!NILP (p)) { struct buffer *given_buffer = current_buffer; @@ -3718,6 +3700,7 @@ annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); } + UNGCPRO; return annotations; } @@ -4439,8 +4422,6 @@ DEFSUBR (Ffile_newer_than_file_p); DEFSUBR (Finsert_file_contents_internal); DEFSUBR (Fwrite_region_internal); - DEFSUBR (Fcar_less_than_car); /* Vomitous! */ - DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */ #if 0 DEFSUBR (Fencrypt_string); DEFSUBR (Fdecrypt_string);
--- a/src/frame-msw.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/frame-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/frame.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/gc.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/glade.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/glyphs-eimage.c Wed Feb 10 07:25:19 2010 -0600 @@ -120,8 +120,15 @@ #define HAVE_BOOLEAN /* prevent jmorecfg.h from redefining it */ #endif +/* Yet more breakage... jmorecfg.h unconditionally defines FAR either as + "far" or as blank. Windef.h unconditionally defines FAR as "far". + We'll avoid the compile warning by redefing FAR the way windows defines it, + after loading the JPEG headers. */ +#undef FAR #include <jpeglib.h> #include <jerror.h> +#undef FAR +#define FAR far END_C_DECLS @@ -598,7 +605,7 @@ } static const char * -gif_decode_error_string () +gif_decode_error_string (void) { switch (GifLastError ()) {
--- a/src/glyphs-msw.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/glyphs-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/glyphs.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/gui-x.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/intl-win32.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/keymap.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/lisp-disunion.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/lisp-union.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/lisp.h Wed Feb 10 07:25:19 2010 -0600 @@ -22,6 +22,9 @@ /* Synched up with: FSF 19.30. */ +#ifndef INCLUDED_lisp_h_ +#define INCLUDED_lisp_h_ + /* Authorship: Based on code from pre-release FSF 19, c. 1991. @@ -50,13 +53,6 @@ Compiler-specific definitions modernized and moved to compiler.h. */ -#ifndef INCLUDED_lisp_h_ -#define INCLUDED_lisp_h_ - -/************************************************************************/ -/* general definitions */ -/************************************************************************/ - /* Conventions in comments: "Mule-izing" is the process of going through a file and eliminating @@ -91,7 +87,9 @@ */ -/* -------------------------- include files --------------------- */ +/************************************************************************/ +/* include files */ +/************************************************************************/ /* We include the following generally useful header files so that you don't have to worry about prototypes when using the standard C @@ -99,7 +97,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> @@ -111,12 +114,11 @@ #endif -/* -------------------------- error-checking ------------------------ */ - -/* The large categories established by configure can be subdivided into - smaller subcategories, for problems in specific modules. You can't - control this using configure, but you can manually stick in a define as - necessary. */ +/************************************************************************/ +/* error checking */ +/************************************************************************/ + +/* ------------------------- large categories ------------------------- */ /* How these work: @@ -141,17 +143,56 @@ the file and line (__FILE__, __LINE__) at place where the call occurs in the calling function; but nothing will get passed in when ERROR_CHECK_TEXT is not defined. + + Currently the full bevy of *foo_checking_assert* macros are defined only + for `text' and `types'; for others, only the basic foo_checking_assert() + macro is defined. Writing out all the variations for all possible error + categories would produce too much clutter. If any of these become + needed, they can always be defined. */ + + /* #### I suggest revamping these and making proper use of the + category/subcategory system. Here is one proposal: + + Major category Minor categories + -------------------------------- + Allocation + Malloc + Dynarr + + Display + Extents + Glyphs + Redisplay + + Execution + Byte-Code + Catch + Garbage Collection + Trapping-Problems + + Lisp Objects + Buffers + Char Tables + Events + Lstreams + Hash Tables + Range Tables + + Types + Lrecord Types + Subtypes + + Text + Byte Positions + Conversion + Eistrings + Itext + Lisp Strings + + --ben */ -#ifdef ERROR_CHECK_STRUCTURES -/* Check for problems with the catch list and specbind stack */ -#define ERROR_CHECK_CATCH -/* Check for insufficient use of call_trapping_problems(), particularly - due to glyph-related changes causing eval or QUIT within redisplay */ -#define ERROR_CHECK_TRAPPING_PROBLEMS -#endif /* ERROR_CHECK_STRUCTURES */ - #define INLINE_ERROR_CHECK_ARGS , const char *__file__, int __line__ #define INLINE_ERROR_CHECK_CALL , __FILE__, __LINE__ #define DISABLED_INLINE_ERROR_CHECK_ARGS @@ -160,8 +201,59 @@ /* For assertions in inline header functions which will report the file and line of the calling function */ #define inline_assert(assertion) assert_at_line (assertion, __file__, __line__) -#define disabled_inline_assert(assertion) \ - disabled_assert_at_line (assertion, __file__, __line__) +/* The following should not use disabled_assert_at_line() because when the + inline assert is disabled, params __file__ and __line__ do not exist. */ +#define disabled_inline_assert(assertion) disabled_assert (assertion) + +/* ------- the specific categories -------- */ + +#if defined (ERROR_CHECK_BYTE_CODE) || defined (ERROR_CHECK_DISPLAY) || defined (ERROR_CHECK_EXTENTS) || defined (ERROR_CHECK_GC) || defined (ERROR_CHECK_GLYPHS) || defined (ERROR_CHECK_MALLOC) || defined (ERROR_CHECK_STRUCTURES) || defined (ERROR_CHECK_TEXT) || defined (ERROR_CHECK_TYPES) +#define ERROR_CHECK_ANY +#endif + +/* KEEP THESE SORTED! */ + +#ifdef ERROR_CHECK_BYTE_CODE +#define byte_code_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_BYTE_CODE */ +#define byte_code_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_BYTE_CODE */ + +#ifdef ERROR_CHECK_DISPLAY +#define display_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_DISPLAY */ +#define display_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_DISPLAY */ + +#ifdef ERROR_CHECK_EXTENTS +#define extent_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_EXTENTS */ +#define extent_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_EXTENTS */ + +#ifdef ERROR_CHECK_GC +#define gc_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_GC */ +#define gc_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_GC */ + +#ifdef ERROR_CHECK_GLYPHS +#define glyph_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_GLYPHS */ +#define glyph_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_GLYPHS */ + +#ifdef ERROR_CHECK_MALLOC +#define malloc_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_MALLOC */ +#define malloc_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_MALLOC */ + +#ifdef ERROR_CHECK_STRUCTURES +#define structure_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_STRUCTURES */ +#define structure_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_STRUCTURES */ #ifdef ERROR_CHECK_TEXT #define text_checking_assert(assertion) assert (assertion) @@ -205,172 +297,51 @@ disabled_assert_with_message (assertion, msg) #endif /* ERROR_CHECK_TYPES */ +/* ------------------------- small categories ------------------------- */ + +/* The large categories established by configure can be subdivided into + smaller subcategories, for problems in specific modules. You can't + control this using configure, but you can manually stick in a define as + necessary. + + The idea is to go ahead and create a new type of error-checking and + have it turned on if the larger category it is a part of is also + turned on. For example, ERROR_CHECK_DYNARR is considered a subcategory + of ERROR_CHECK_STRUCTURES. + + We also define foo_checking_assert() macros for convenience, but + generally don't define the many variations of this macro as for the + major types above, because it produces too much clutter. If any of + these become needed, they can always be defined. */ + #ifdef ERROR_CHECK_STRUCTURES -#define structure_checking_assert(assertion) assert (assertion) -#define structure_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_structure_checking_assert(assertion) inline_assert (assertion) -#define INLINE_STRUCTURE_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_STRUCTURE_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define structure_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_STRUCTURES */ -#define structure_checking_assert(assertion) disabled_assert (assertion) -#define structure_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_structure_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_STRUCTURE_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_STRUCTURE_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define structure_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) +/* Check for problems with the catch list and specbind stack */ +#define ERROR_CHECK_CATCH +/* Check for incoherent Dynarr structures, attempts to access Dynarr + positions out of range, reentrant use of Dynarrs through Dynarr locking, + etc. */ +#define ERROR_CHECK_DYNARR +/* Check for insufficient use of call_trapping_problems(), particularly + due to glyph-related changes causing eval or QUIT within redisplay */ +#define ERROR_CHECK_TRAPPING_PROBLEMS #endif /* ERROR_CHECK_STRUCTURES */ -#ifdef ERROR_CHECK_GC -#define gc_checking_assert(assertion) assert (assertion) -#define gc_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_gc_checking_assert(assertion) inline_assert (assertion) -#define INLINE_GC_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_GC_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define gc_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_GC */ -#define gc_checking_assert(assertion) disabled_assert (assertion) -#define gc_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_gc_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_GC_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_GC_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define gc_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_GC */ - -#ifdef ERROR_CHECK_DISPLAY -#define display_checking_assert(assertion) assert (assertion) -#define display_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_display_checking_assert(assertion) inline_assert (assertion) -#define INLINE_DISPLAY_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_DISPLAY_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define display_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_DISPLAY */ -#define display_checking_assert(assertion) disabled_assert (assertion) -#define display_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_display_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_DISPLAY_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_DISPLAY_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define display_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_DISPLAY */ - -#ifdef ERROR_CHECK_GLYPHS -#define glyph_checking_assert(assertion) assert (assertion) -#define glyph_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_glyph_checking_assert(assertion) inline_assert (assertion) -#define INLINE_GLYPH_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_GLYPH_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define glyph_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_GLYPHS */ -#define glyph_checking_assert(assertion) disabled_assert (assertion) -#define glyph_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_glyph_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_GLYPH_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_GLYPH_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define glyph_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_GLYPHS */ - -#ifdef ERROR_CHECK_EXTENTS -#define extent_checking_assert(assertion) assert (assertion) -#define extent_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_extent_checking_assert(assertion) inline_assert (assertion) -#define INLINE_EXTENT_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_EXTENT_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define extent_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_EXTENTS */ -#define extent_checking_assert(assertion) disabled_assert (assertion) -#define extent_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_extent_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_EXTENT_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_EXTENT_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define extent_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_EXTENTS */ - -#ifdef ERROR_CHECK_MALLOC -#define malloc_checking_assert(assertion) assert (assertion) -#define malloc_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_malloc_checking_assert(assertion) inline_assert (assertion) -#define INLINE_MALLOC_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_MALLOC_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define malloc_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_MALLOC */ -#define malloc_checking_assert(assertion) disabled_assert (assertion) -#define malloc_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_malloc_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_MALLOC_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_MALLOC_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define malloc_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_MALLOC */ - -#ifdef ERROR_CHECK_BYTE_CODE -#define byte_code_checking_assert(assertion) assert (assertion) -#define byte_code_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_byte_code_checking_assert(assertion) inline_assert (assertion) -#define INLINE_BYTE_CODE_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_BYTE_CODE_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define byte_code_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) -#else /* not ERROR_CHECK_BYTE_CODE */ -#define byte_code_checking_assert(assertion) disabled_assert (assertion) -#define byte_code_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_byte_code_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_BYTE_CODE_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_BYTE_CODE_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define byte_code_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) -#endif /* ERROR_CHECK_BYTE_CODE */ +#ifdef ERROR_CHECK_CATCH +#define catch_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_CATCH */ +#define catch_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_CATCH */ + +#ifdef ERROR_CHECK_DYNARR +#define dynarr_checking_assert(assertion) assert (assertion) +#else /* not ERROR_CHECK_DYNARR */ +#define dynarr_checking_assert(assertion) disabled_assert (assertion) +#endif /* ERROR_CHECK_DYNARR */ #ifdef ERROR_CHECK_TRAPPING_PROBLEMS #define trapping_problems_checking_assert(assertion) assert (assertion) -#define trapping_problems_checking_assert_at_line(assertion, file, line) \ - assert_at_line (assertion, file, line) -#define inline_trapping_problems_checking_assert(assertion) inline_assert (assertion) -#define INLINE_TRAPPING_PROBLEMS_CHECK_ARGS INLINE_ERROR_CHECK_ARGS -#define INLINE_TRAPPING_PROBLEMS_CHECK_CALL INLINE_ERROR_CHECK_CALL -#define trapping_problems_checking_assert_with_message(assertion, msg) \ - assert_with_message (assertion, msg) #else /* not ERROR_CHECK_TRAPPING_PROBLEMS */ #define trapping_problems_checking_assert(assertion) disabled_assert (assertion) -#define trapping_problems_checking_assert_at_line(assertion, file, line) \ - disabled_assert_at_line (assertion, file, line) -#define inline_trapping_problems_checking_assert(assertion) \ - disabled_inline_assert (assertion) -#define INLINE_TRAPPING_PROBLEMS_CHECK_ARGS DISABLED_INLINE_ERROR_CHECK_ARGS -#define INLINE_TRAPPING_PROBLEMS_CHECK_CALL DISABLED_INLINE_ERROR_CHECK_CALL -#define trapping_problems_checking_assert_with_message(assertion, msg) \ - disabled_assert_with_message (assertion, msg) #endif /* ERROR_CHECK_TRAPPING_PROBLEMS */ /************************************************************************/ @@ -1596,6 +1567,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 +1682,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 **/ /************************************************************************/ @@ -1714,7 +1735,7 @@ #define DECLARE_DYNARR_LISP_IMP() #endif -#ifdef ERROR_CHECK_STRUCTURES +#ifdef ERROR_CHECK_DYNARR #define DECLARE_DYNARR_LOCKED() \ int locked; #else @@ -1754,7 +1775,7 @@ /************* Dynarr verification *************/ -#ifdef ERROR_CHECK_STRUCTURES +#ifdef ERROR_CHECK_DYNARR DECLARE_INLINE_HEADER ( int Dynarr_verify_pos_at (void *d, int pos, const Ascbyte *file, int line) @@ -1775,7 +1796,7 @@ Dynarr *dy = (Dynarr *) d; /* We use `largest', not `len', because the redisplay code often accesses stuff between len and largest. */ - /* Code will often do something like ... + /* [[ Code will often do something like ... val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), Dynarr_length (dyn)); @@ -1785,7 +1806,11 @@ allocated array, but the array may not have ever been allocated and hence the return value is NULL. But the length of 0 causes the pointer to never get checked. These can occur throughout the code - so we put in a special check. */ + so we put in a special check. --ben ]] + + Update: The common idiom `Dynarr_atp (dyn, 0)' has been changed to + `Dynarr_begin (dyn)'. Possibly this special check at POS 0 can be + done only for Dynarr_begin() not for general Dynarr_atp(). --ben */ if (pos == 0 && dy->len_ == 0) return pos; /* #### It's vaguely possible that some code could legitimately want to @@ -1798,7 +1823,7 @@ really want to check for cases of accessing just past the end of memory, which is a likely off-by-one problem to occur and will usually not trigger a protection fault (instead, you'll just get random - behavior, possibly overwriting other memory, which is bad). */ + behavior, possibly overwriting other memory, which is bad). --ben */ assert_at_line (pos >= 0 && pos < dy->largest_, file, line); return pos; } @@ -1822,9 +1847,9 @@ #define Dynarr_verify_pos_at(d, pos, file, line) (pos) #define Dynarr_verify_pos_atp(d, pos, file, line) (pos) #define Dynarr_verify_pos_atp_allow_end(d, pos, file, line) (pos) -#endif /* ERROR_CHECK_STRUCTURES */ - -#ifdef ERROR_CHECK_STRUCTURES +#endif /* ERROR_CHECK_DYNARR */ + +#ifdef ERROR_CHECK_DYNARR DECLARE_INLINE_HEADER ( Dynarr * Dynarr_verify_1 (void *d, const Ascbyte *file, int line) @@ -1859,11 +1884,11 @@ dy->locked = 0; \ } while (0) #else -#define Dynarr_verify(d) (d) -#define Dynarr_verify_mod(d) (d) +#define Dynarr_verify(d) ((Dynarr *) d) +#define Dynarr_verify_mod(d) ((Dynarr *) d) #define Dynarr_lock(d) DO_NOTHING #define Dynarr_unlock(d) DO_NOTHING -#endif /* ERROR_CHECK_STRUCTURES */ +#endif /* ERROR_CHECK_DYNARR */ /************* Dynarr creation *************/ @@ -1887,8 +1912,7 @@ /************* Dynarr access *************/ -#ifdef ERROR_CHECK_STRUCTURES -/* Enabling this leads to crashes in Cygwin 1.7, gcc 3.4.4 */ +#ifdef ERROR_CHECK_DYNARR #define Dynarr_at(d, pos) \ ((d)->base[Dynarr_verify_pos_at (d, pos, __FILE__, __LINE__)]) #define Dynarr_atp_allow_end(d, pos) \ @@ -1927,7 +1951,7 @@ #define Dynarr_set_length_1(d, n) \ do { \ Elemcount _dsl1_n = (n); \ - structure_checking_assert (_dsl1_n >= 0 && _dsl1_n <= Dynarr_max (d)); \ + dynarr_checking_assert (_dsl1_n >= 0 && _dsl1_n <= Dynarr_max (d)); \ (void) Dynarr_verify_mod (d); \ (d)->len_ = _dsl1_n; \ /* Use the raw field references here otherwise we get a crash because \ @@ -1942,7 +1966,7 @@ #define Dynarr_set_length(d, n) \ do { \ Elemcount _dsl_n = (n); \ - structure_checking_assert (_dsl_n >= 0 && _dsl_n <= Dynarr_largest (d)); \ + dynarr_checking_assert (_dsl_n >= 0 && _dsl_n <= Dynarr_largest (d)); \ Dynarr_set_length_1 (d, _dsl_n); \ } while (0) #define Dynarr_increment(d) \ @@ -2032,7 +2056,7 @@ } #define Dynarr_pop(d) \ - (structure_checking_assert (Dynarr_length (d) > 0), \ + (dynarr_checking_assert (Dynarr_length (d) > 0), \ Dynarr_verify_mod (d)->len_--, \ Dynarr_at (d, Dynarr_length (d))) #define Dynarr_delete(d, i) Dynarr_delete_many (d, i, 1) @@ -3897,7 +3921,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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/lread.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/menubar-gtk.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/menubar-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/menubar-x.c Wed Feb 10 07:25:19 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/nt.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/nt.c Wed Feb 10 07:25:19 2010 -0600 @@ -963,7 +963,7 @@ nr.dwUsage = RESOURCEUSAGE_CONTAINER; nr.lpLocalName = NULL; PATHNAME_CONVERT_OUT (path, extpath); - nr.lpRemoteName = (LPTSTR) extpath; + nr.lpRemoteName = (XELPTSTR) extpath; nr.lpComment = NULL; nr.lpProvider = NULL;
--- a/src/number-gmp.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/number-gmp.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/objects-msw.c Wed Feb 10 07:25:19 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))) { @@ -2093,7 +2097,7 @@ UNGCPRO; return 0; } - + if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET) { 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/objects-tty.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/objects-xlike-inc.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/objects.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/print.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/process-unix.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/process.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/profile.c Wed Feb 10 07:25:19 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/s/hpux11-shr.h Wed Feb 10 07:15:36 2010 -0600 +++ b/src/s/hpux11-shr.h Wed Feb 10 07:25:19 2010 -0600 @@ -1,6 +1,24 @@ -/* Synched up with: FSF 19.31. */ +/* For building XEmacs under HPUX 11.0 with dynamic libraries. + Copyright (C) 1985, 1986 Free Software Foundation, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. -/* For building XEmacs under HPUX 11.0 with dynamic libraries. */ +XEmacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin St. - Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* Synched up with: FSF 19.31. */ #define ORDINARY_LINK
--- a/src/scrollbar-msw.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/scrollbar-msw.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/search.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/signal.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/specifier.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/specifier.h Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/strftime.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/syntax.c Wed Feb 10 07:25:19 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/syswindows.h Wed Feb 10 07:15:36 2010 -0600 +++ b/src/syswindows.h Wed Feb 10 07:25:19 2010 -0600 @@ -20,6 +20,9 @@ /* Synched up with: Not in FSF. */ +#ifndef INCLUDED_syswindows_h_ +#define INCLUDED_syswindows_h_ + /* Authorship: Current primary author: Ben Wing <ben@xemacs.org> @@ -36,10 +39,98 @@ */ -#ifndef INCLUDED_syswindows_h_ -#define INCLUDED_syswindows_h_ +/* See win32.c for info about the different Windows files in XEmacs. */ + +/* + A capsule introduction to Windows-related build flags: + + See also: (Info-goto-node "(internals)Windows Build Flags") + + 1. Operating-system level: + -------------------------- + + `CYGWIN' Compiled for Cygwin. Cygwin provides a full Unix-like + environment under Windows. Applications compiled for Cygwin + are linked with CYGWIN1.DLL, which provides the POSIX + emulation. + + Corresponding s/ file: s/cygwin32.h + + `MINGW' Compiled for MinGW. MinGW is a Unix-like environment under + Windows that allows for the use of `gcc' to create fully + native Windows applications that link with the normal + Microsoft C-runtime library (e.g. MSVCRT.DLL), and don't + require a special POSIX-emulation DLL (e.g. CYGWIN1.DLL). + Conversely, the only POSIX-like services available are + those in MSVCRT.DLL, which isn't much. Essentially, coding + for MinGW is identical to coding for native Windows using + Visual C++ or the like, whereas coding for Cygwin is like + coding for Linux, but with the additional possibility of + making Win32-API calls. Additional confusion comes from + the fact that you can use the Cygwin environment and + compilers to build a MINGW application (e.g. by passing the + `-mno-cygwin' command-line argument to `gcc'). + + Corresponding s/ file: s/mingw32.h + + (none) There's no flag to indicate that you are specifically + targetting native Windows and not doing this with MINGW. + Presumably this means you're using Visual C++. + + Corresponding s/ file: s/windowsnt.h + + `WIN32_ANY' Any of the above three environments. + + Corresponding s/ file: s/win32-common.h -/* See win32.c for info about the different Windows files in XEmacs. */ + `WIN32_NATIVE' + Native Windows target, either MinGW or Visual C++. + That is, not Cygwin. + + Corresponding s/ file: s/win32-native.h + + + 2. Compiler level: + ------------------ + + `__GNUC__' Defined whenever compiling with gcc (Cygwin or MinGW). + + `_MSC_VER' Defined whenever compiling with Visual C++. + + `CYGWIN_HEADERS' + Defined whenever using Cygwin-style header files rather + than Visual C++ headers. Currently this means the same + as "Cygwin or MinGW" and the same as "compiling with gcc". + This applies especially to the header files in + /usr/include/w32api, which is a free replacement for the + standard Visual C++ headers for the Win32 API. + + + 3. Window-system level: + ----------------------- + + `HAVE_MS_WINDOWS' + MS Windows native windowing system (anything related to the + appearance of the graphical screen). May or may not apply + to any of VC++, MinGW, or Cygwin. For example, it's + definitely possible to compile XEmacs under Cygwin with + support for X-Windows frames and TTY frames, but no + native MS Windows frames. It may also be possible to do that + under MinGW or (less likely, but feasible) Visual C++. + + `HAVE_X_WINDOWS' + Support for X-Windows frames, regardless of whether under + MS Windows. You can certainly compile XEmacs with support + for X-Windows frames when running on MS Windows, using Cygwin. + + `HAVE_GTK', `HAVE_TTY' + Likewise. All are available on MS Windows with Cygwin. + + Note further that more than one of these can be defined at the same time. + In fact, in general, it's possible to compile with support for all of + these at the same time. + +*/ /* ------------------------- Basic includes ------------------------- */
--- a/src/tests.c Wed Feb 10 07:15:36 2010 -0600 +++ b/src/tests.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/text.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/text.h Wed Feb 10 07:25:19 2010 -0600 @@ -2871,10 +2871,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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/tooltalk.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/ui-byhand.c Wed Feb 10 07:25:19 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 Wed Feb 10 07:15:36 2010 -0600 +++ b/src/ui-gtk.c Wed Feb 10 07:25:19 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 */