Mercurial > hg > xemacs-beta
changeset 801:2b676dc88c66
[xemacs-hg @ 2002-04-01 03:58:02 by ben]
bug fixes (e.g. ballooning on X windows)
Makefile.in.in: Try to make the Makefile notice if its source Makefile.in.in is
changed, and regenerate and run itself.
Use a bigger default SHEAP_ADJUSTMENT on Cygwin; otherwise you
can't compile under Mule if a Lisp file has changed. (can't run
temacs)
TODO.ben-mule-21-5: update.
mule/mule-cmds.el: Hash the result of mswindows-get-language-environment-from-locale,
since it's very expensive (and causes huge ballooning of memory
under X Windows, since it's called from x-get-resource).
cl-extra.el, code-files.el, files.el, simple.el, subr.el, x-faces.el: Create new string-equal-ignore-case, based on built-in
compare-strings -- compare strings ignoring case without the need
to generate garbage by calling downcase. Use it in equalp and
elsewhere.
alloc.c, bytecode.c, chartab.c, data.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-unixoid.c, extents.c, file-coding.c, fileio.c, fns.c, glyphs.c, gutter.c, lisp-union.h, lisp.h, mule-charset.c, nt.c, process-unix.c, process.c, specifier.c, symbols.c, sysdep.c, sysdep.h, text.c, toolbar.c: Try to implement GC triggering based on percentage of total memory
usage. Not currently activated (percentage set to 0) because not
quite working. Add `memory-usage' primitive to return XEmacs'
idea of its memory usage.
Add primitive compare-strings, compatible with FSF 21.1 -- can
compare any part of two strings, optionally ignoring case.
Improve qxe() functions in text.c for text comparison.
Use RETURN_NOT_REACHED to try to avoid warnings about unreachable
code.
Add volatile_make_int() to fix warning in unix_send_process().
author | ben |
---|---|
date | Mon, 01 Apr 2002 03:59:04 +0000 |
parents | a5954632b187 |
children | 19dfb459d51a |
files | ChangeLog Makefile.in.in TODO.ben-mule-21-5 lisp/ChangeLog lisp/cl-extra.el lisp/code-files.el lisp/files.el lisp/mule/mule-cmds.el lisp/simple.el lisp/subr.el lisp/x-faces.el src/ChangeLog src/alloc.c src/bytecode.c src/chartab.c src/data.c src/elhash.c src/emacs.c src/eval.c src/event-Xt.c src/event-unixoid.c src/extents.c src/file-coding.c src/fileio.c src/fns.c src/glyphs.c src/gutter.c src/lisp-union.h src/lisp.h src/mule-charset.c src/nt.c src/process-unix.c src/process.c src/specifier.c src/symbols.c src/sysdep.c src/sysdep.h src/text.c src/toolbar.c |
diffstat | 39 files changed, 621 insertions(+), 153 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Sun Mar 31 08:30:17 2002 +0000 +++ b/ChangeLog Mon Apr 01 03:59:04 2002 +0000 @@ -1,3 +1,18 @@ +2002-03-31 Ben Wing <ben@xemacs.org> + + * Makefile.in.in (all): + * Makefile.in.in (finder): + * Makefile.in.in (Makefile): + * Makefile.in.in (SOURCES): + Try to make the Makefile notice if its source Makefile.in.in is + changed, and regenerate and run itself. + + Use a bigger default SHEAP_ADJUSTMENT on Cygwin; otherwise you + can't compile under Mule if a Lisp file has changed. (can't run + temacs) + + * TODO.ben-mule-21-5 (bugs): update. + 2002-03-31 Ben Wing <ben@xemacs.org> * TODO.ben-mule-21-5 (bugs): Update.
--- a/Makefile.in.in Sun Mar 31 08:30:17 2002 +0000 +++ b/Makefile.in.in Mon Apr 01 03:59:04 2002 +0000 @@ -242,7 +242,7 @@ GENERATED_HEADERS = src/paths.h src/Emacs.ad.h src/config.h lwlib/config.h src/sheap-adjust.h GENERATED_LISP = lisp/finder-inf.el -all: ${PROGNAME} all-elc info +all: Makefile ${PROGNAME} all-elc info ${PROGNAME}: ${GENERATED_HEADERS} ${MAKE_SUBDIR} ${GENERATED_LISP} @@ -323,7 +323,7 @@ @echo "Resetting \`src/sheap-adjust.h'."; \ (echo "/* Do not edit this file!" ; \ echo " Automatically generated by XEmacs */" ; \ - echo "#define SHEAP_ADJUSTMENT 0") > $@ + echo "#define SHEAP_ADJUSTMENT 0x400000") > $@ src: @SRC_SUBDIR_DEPS@ FRC.src pkg-src/tree-x: pkg-src/FRC.tree-x @@ -336,8 +336,9 @@ ${SUBDIR}: ${SUBDIR_MAKEFILES} ${GENERATED_HEADERS} FRC cd ./$@ && $(RECURSIVE_MAKE) all -Makefile: ${srcdir}/Makefile.in config.status +Makefile: ${srcdir}/Makefile.in.in config.status ./config.status + $(RECURSIVE_MAKE) all src/Makefile: ${srcdir}/src/Makefile.in.in ${srcdir}/src/depend config.status ./config.status @@ -606,7 +607,7 @@ ## Note: it's no disaster if these productions miss a file or two; tar ## and VC will swiftly let you know if this happens, and it is easily ## corrected. -SOURCES = ChangeLog GETTING.GNU.SOFTWARE INSTALL Makefile.in PROBLEMS \ +SOURCES = ChangeLog GETTING.GNU.SOFTWARE INSTALL Makefile.in.in PROBLEMS \ README build-install.in configure make-dist move-if-change .PHONY: unlock relock TAGS tags check dist info dvi mcs
--- a/TODO.ben-mule-21-5 Sun Mar 31 08:30:17 2002 +0000 +++ b/TODO.ben-mule-21-5 Mon Apr 01 03:59:04 2002 +0000 @@ -33,6 +33,12 @@ -- review use of escape-quoted in auto_save_1() vs. the buffer's own coding system. +-- figure out how to get the total amount of data memory (i.e. everything + but the code, or even including the code if can't distinguish) used by + the process on each different OS, and use it in a new algorithm for + triggering GC: trigger only when a certain % of the data size has been + consed up; in addition, have a minimum. + fixed bugs??? -- Occasional crash when freeing display structures. The problem seems to
--- a/lisp/ChangeLog Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/ChangeLog Mon Apr 01 03:59:04 2002 +0000 @@ -1,3 +1,29 @@ +2002-03-31 Ben Wing <ben@xemacs.org> + + * mule/mule-cmds.el: + * mule/mule-cmds.el (langenv-to-locale-hash): New. + * mule/mule-cmds.el (mswindows-get-language-environment-from-locale): + Hash the result of mswindows-get-language-environment-from-locale, + since it's very expensive (and causes huge ballooning of memory + under X Windows, since it's called from x-get-resource). + +2002-03-31 Ben Wing <ben@xemacs.org> + + * cl-extra.el: + * cl-extra.el (equalp): + * code-files.el (load): + * files.el (hack-local-variables-last-page): + * files.el (hack-local-variables-prop-line): + * simple.el (assoc-ignore-case): + * subr.el: + * subr.el (string-equal-ignore-case): New. + * x-faces.el (x-frob-font-size): + * x-faces.el (x-init-device-faces): + Create new string-equal-ignore-case, based on built-in + compare-strings -- compare strings ignoring case without the need + to generate garbage by calling downcase. Use it in equalp and + elsewhere. + 2002-03-31 Ben Wing <ben@xemacs.org> * behavior.el:
--- a/lisp/cl-extra.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/cl-extra.el Mon Apr 01 03:59:04 2002 +0000 @@ -1,6 +1,7 @@ ;;; cl-extra.el --- Common Lisp extensions for XEmacs Lisp (part two) ;; Copyright (C) 1993 Free Software Foundation, Inc. +;; Copyright (C) 2002 Ben Wing. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Maintainer: XEmacs Development Team @@ -99,9 +100,8 @@ strings case-insensitively." (cond ((eq x y) t) ((stringp x) - (and (stringp y) (= (length x) (length y)) - (or (string-equal x y) - (string-equal (downcase x) (downcase y))))) ; lazy but simple! + ;; avoids downcase + (eq t (compare-strings x nil nil y nil nil t))) ((characterp x) (and (characterp y) (or (char-equal x y)
--- a/lisp/code-files.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/code-files.el Mon Apr 01 03:59:04 2002 +0000 @@ -246,7 +246,7 @@ (load-internal file noerror nomessage nosuffix (let ((elc ; use string= instead of string-match to keep match-data. - (string= ".elc" (downcase (substring path -4))))) + (equalp ".elc" (substring path -4)))) (or (and (not elc) coding-system-for-read) ; prefer for source file ;; find magic-cookie (let ((codesys (find-coding-system-magic-cookie-in-file path)))
--- a/lisp/files.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/files.el Mon Apr 01 03:59:04 2002 +0000 @@ -1601,7 +1601,7 @@ (var (read str)) val) ;; Setting variable named "end" means end of list. - (if (string-equal (downcase str) "end") + (if (equalp str "end") (setq continue nil) ;; Otherwise read the variable value. (skip-chars-forward "^:") @@ -1665,7 +1665,7 @@ (narrow-to-region (point) end) (read (current-buffer))))) ;; Case sensitivity! Icepicks in my forehead! - (if (equal (downcase (symbol-name key)) "mode") + (if (equalp (symbol-name key) "mode") (setq key 'mode)) (setq result (cons (cons key val) result)) (skip-chars-forward " \t;")))
--- a/lisp/mule/mule-cmds.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/mule/mule-cmds.el Mon Apr 01 03:59:04 2002 +0000 @@ -1009,22 +1009,29 @@ ;; auto-language-alist deleted. We have a more sophisticated system, ;; with the locales stored in the language data. +(defconst langenv-to-locale-hash (make-hash-table :test 'equal)) + (defun get-language-environment-from-locale (locale) "Convert LOCALE into a language environment. LOCALE is a C library locale string, as returned by `current-locale'. Uses the `locale' property of the language environment." - (block langenv - (dolist (langcons language-info-alist) - (let* ((lang (car langcons)) - (locs (get-language-info lang 'locale)) - (case-fold-search t)) - (dolist (loc (if (listp locs) locs (list locs))) - (if (cond ((functionp loc) - (funcall loc locale)) - ((stringp loc) - (string-match (concat "^" loc "\\([^A-Za-z0-9]\\|$\\)") - locale))) - (return-from langenv lang))))))) + (or (gethash locale langenv-to-locale-hash) + (let ((retval + (block langenv + (dolist (langcons language-info-alist) + (let* ((lang (car langcons)) + (locs (get-language-info lang 'locale)) + (case-fold-search t)) + (dolist (loc (if (listp locs) locs (list locs))) + (if (cond ((functionp loc) + (funcall loc locale)) + ((stringp loc) + (string-match + (concat "^" loc "\\([^A-Za-z0-9]\\|$\\)") + locale))) + (return-from langenv lang)))))))) + (puthash locale retval langenv-to-locale-hash) + retval))) (defun mswindows-get-language-environment-from-locale (ms-locale) "Convert MS-LOCALE (an MS Windows locale) into a language environment.
--- a/lisp/simple.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/simple.el Mon Apr 01 03:59:04 2002 +0000 @@ -3626,13 +3626,7 @@ (defun assoc-ignore-case (key alist) "Like `assoc', but assumes KEY is a string and ignores case when comparing." - (setq key (downcase key)) - (let (element) - (while (and alist (not element)) - (if (equal key (downcase (car (car alist)))) - (setq element (car alist))) - (setq alist (cdr alist))) - element)) + (assoc* key alist :test #'equalp)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- a/lisp/subr.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/subr.el Mon Apr 01 03:59:04 2002 +0000 @@ -363,6 +363,19 @@ ;;;; String functions. ;; XEmacs +(defun string-equal-ignore-case (str1 str2) + "Return t if two strings have identical contents, ignoring case differences. +Case is not significant. Text properties and extents are ignored. +Symbols are also allowed; their print names are used instead. + +See also `equalp'." + (if (symbolp str1) + (setq str1 (symbol-name str1))) + (if (symbolp str2) + (setq str2 (symbol-name str2))) + (eq t (compare-strings str1 nil nil str2 nil nil t))) + +;; XEmacs (defun replace-in-string (str regexp newtext &optional literal) "Replace all matches in STR for REGEXP with NEWTEXT string, and returns the new string. @@ -592,6 +605,7 @@ (and padding (> end-column len) (make-string (- end-column len) padding))))) + ;; alist/plist functions (defun plist-to-alist (plist)
--- a/lisp/x-faces.el Sun Mar 31 08:30:17 2002 +0000 +++ b/lisp/x-faces.el Mon Apr 01 03:59:04 2002 +0000 @@ -338,12 +338,11 @@ (let ((rest available) (last nil) result) - (setq font (downcase font)) (while rest - (cond ((and (not up-p) (equal font (downcase (nth 2 (car rest))))) + (cond ((and (not up-p) (equalp font (nth 2 (car rest)))) (setq result last rest nil)) - ((and up-p (equal font (and last (downcase (nth 2 last))))) + ((and up-p (equalp font (and last (nth 2 last)))) (setq result (car rest) rest nil))) (setq last (car rest)) @@ -702,8 +701,8 @@ (let ((fg (face-foreground-instance 'default device)) (bg (face-background-instance 'default device))) (if (not (and fg bg)) - (if (or (and fg (equal (downcase (color-instance-name fg)) "white")) - (and bg (equal (downcase (color-instance-name bg)) "black"))) + (if (or (and fg (equalp (color-instance-name fg) "white")) + (and bg (equalp (color-instance-name bg) "black"))) (progn (or fg (set-face-foreground 'default "white" device)) (or bg (set-face-background 'default "black" device)))
--- a/src/ChangeLog Sun Mar 31 08:30:17 2002 +0000 +++ b/src/ChangeLog Mon Apr 01 03:59:04 2002 +0000 @@ -1,3 +1,90 @@ +2002-03-31 Ben Wing <ben@xemacs.org> + + * alloc.c: + * alloc.c (INCREMENT_CONS_COUNTER): + * alloc.c (xmalloc): + * alloc.c (xcalloc): + * alloc.c (xrealloc): + * alloc.c (Fmemory_limit): + * alloc.c (Fmemory_usage): + * alloc.c (common_init_alloc_once_early): + * alloc.c (syms_of_alloc): + * alloc.c (vars_of_alloc): + * bytecode.c: + * bytecode.c (Ffetch_bytecode): + * chartab.c (symbol_to_char_table_type): + * chartab.c (Fget_range_char_table): + * chartab.c (check_valid_char_table_value): + * data.c (Faref): + * data.c (Faset): + * data.c (Fquo): + * data.c (Fmod): + * data.c (decode_weak_list_type): + * data.c (encode_weak_list_type): + * elhash.c (decode_hash_table_weakness): + * elhash.c (decode_hash_table_test): + * emacs.c (main): + * eval.c: + * eval.c (Feval): + * eval.c (Ffuncall): + * event-Xt.c (x_to_emacs_keysym): + * event-unixoid.c: + * event-unixoid.c (poll_fds_for_input): + * extents.c (decode_extent_at_flag): + * extents.c (symbol_to_glyph_layout): + * file-coding.c (symbol_to_eol_type): + * file-coding.c (Fcoding_system_aliasee): + * file-coding.c (coding_category_symbol_to_id): + * fileio.c (report_file_type_error): + * fileio.c (Fsubstitute_in_file_name): + * fns.c: + * fns.c (Fcompare_strings): + * fns.c (internal_equalp): + * fns.c (syms_of_fns): + * glyphs.c (process_image_string_instantiator): + * gutter.c (decode_gutter_position): + * lisp-union.h: + * lisp.h: + * lisp.h (RETURN_NOT_REACHED): + * mule-charset.c (Fcharset_property): + * nt.c (mswindows_stat): + * process-unix.c (unix_create_process): + * process.c (decode_signal): + * specifier.c (decode_locale_type): + * specifier.c (decode_how_to_add_specification): + * symbols.c (decode_magic_handler_type): + * symbols.c (handler_type_from_function_symbol): + * sysdep.c: + * sysdep.c (start_of_data): + * sysdep.c (total_data_usage): + * sysdep.h (total_data_usage): + * text.c: + * text.c (qxestrncasecmp_i18n): + * text.c (qxememcmp4): + * text.c (qxememcasecmp4): + * text.c (qxetextcmp): + * text.c (qxetextcmp_matching): + * text.c (qxetextcasecmp): + * text.c (qxetextcasecmp_matching): + * text.c (lisp_strcasecmp_i18n): + * text.c (eicmp_1): + * toolbar.c (decode_toolbar_position): + * toolbar.c (Fset_default_toolbar_position): + Try to implement GC triggering based on percentage of total memory + usage. Not currently activated (percentage set to 0) because not + quite working. Add `memory-usage' primitive to return XEmacs' + idea of its memory usage. + + Add primitive compare-strings, compatible with FSF 21.1 -- can + compare any part of two strings, optionally ignoring case. + Improve qxe() functions in text.c for text comparison. + + Use RETURN_NOT_REACHED to try to avoid warnings about unreachable + code. + + Add volatile_make_int() to fix warning in unix_send_process(). + + 2002-03-31 Ben Wing <ben@xemacs.org> * s/windowsnt.h:
--- a/src/alloc.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/alloc.c Mon Apr 01 03:59:04 2002 +0000 @@ -100,20 +100,22 @@ } while (0) #ifdef DEBUG_XEMACS -#define INCREMENT_CONS_COUNTER(foosize, type) \ - do { \ - if (debug_allocation) \ - { \ - stderr_out ("allocating %s (size %ld)\n", type, (long)foosize); \ - debug_allocation_backtrace (); \ - } \ - INCREMENT_CONS_COUNTER_1 (foosize); \ +#define INCREMENT_CONS_COUNTER(foosize, type) \ + do { \ + if (debug_allocation) \ + { \ + stderr_out ("allocating %s (size %ld)\n", type, \ + (long) foosize); \ + debug_allocation_backtrace (); \ + } \ + INCREMENT_CONS_COUNTER_1 (foosize); \ } while (0) #define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \ do { \ if (debug_allocation > 1) \ { \ - stderr_out ("allocating noseeum %s (size %ld)\n", type, (long)foosize); \ + stderr_out ("allocating noseeum %s (size %ld)\n", type, \ + (long) foosize); \ debug_allocation_backtrace (); \ } \ INCREMENT_CONS_COUNTER_1 (foosize); \ @@ -131,7 +133,16 @@ } while (0) /* Number of bytes of consing since gc before another gc should be done. */ -EMACS_INT gc_cons_threshold; +static EMACS_INT gc_cons_threshold; + +/* Percentage of consing of total data size before another GC. */ +static EMACS_INT gc_cons_percentage; + +#ifdef ERROR_CHECK_GC +int always_gc; /* Debugging hack */ +#else +#define always_gc 0 +#endif /* Nonzero during gc */ int gc_in_progress; @@ -167,6 +178,11 @@ #endif +/* Very cheesy ways of figuring out how much memory is being used for + data. #### Need better (system-dependent) ways. */ +void *minimum_address_seen; +void *maximum_address_seen; + int c_readonly (Lisp_Object obj) { @@ -239,15 +255,33 @@ out_of_memory ("Memory exhausted", Qunbound); } -/* like malloc and realloc but check for no memory left, and block input. */ +static void +set_alloc_mins_and_maxes (void *val, Bytecount size) +{ + if (!val) + return; + if ((char *) val + size > (char *) maximum_address_seen) + maximum_address_seen = (char *) val + size; + if (!minimum_address_seen) + minimum_address_seen = +#if SIZEOF_VOID_P == 8 + (void *) 0xFFFFFFFFFFFFFFFF; +#else + (void *) 0xFFFFFFFF; +#endif + if ((char *) val < (char *) minimum_address_seen) + minimum_address_seen = (char *) val; +} + +/* like malloc and realloc but check for no memory left. */ #undef xmalloc void * xmalloc (Bytecount size) { void *val = malloc (size); - if (!val && (size != 0)) memory_full (); + set_alloc_mins_and_maxes (val, size); return val; } @@ -258,6 +292,7 @@ void *val = calloc (nelem, elsize); if (!val && (nelem != 0)) memory_full (); + set_alloc_mins_and_maxes (val, nelem * elsize); return val; } @@ -274,6 +309,7 @@ block = realloc (block, size); if (!block && (size != 0)) memory_full (); + set_alloc_mins_and_maxes (block, size); return block; } @@ -3900,8 +3936,8 @@ #if 0 DEFUN ("memory-limit", Fmemory_limit, 0, 0, 0, /* -Return the address of the last byte Emacs has allocated, divided by 1024. -This may be helpful in debugging Emacs's memory usage. +Return the address of the last byte XEmacs has allocated, divided by 1024. +This may be helpful in debugging XEmacs's memory usage. The value is divided by 1024 to make sure it will fit in a lisp integer. */ ()) @@ -3910,6 +3946,27 @@ } #endif +DEFUN ("memory-usage", Fmemory_usage, 0, 0, 0, /* +Return the total number of bytes used by the data segment in XEmacs. +This may be helpful in debugging XEmacs's memory usage. +*/ + ()) +{ + return make_int (total_data_usage ()); +} + +/* True if it's time to garbage collect now. */ +int +need_to_garbage_collect (void) +{ + if (always_gc) + return 1; + + return (consing_since_gc > gc_cons_threshold && + (100 * consing_since_gc) / total_data_usage () >= + gc_cons_percentage); +} + int object_dead_p (Lisp_Object obj) @@ -4117,6 +4174,9 @@ #else gc_cons_threshold = 15000; /* debugging */ #endif + gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of + memory usage on Windows; not verified on other + systems */ lrecord_uid_counter = 259; debug_string_purity = 0; gcprolist = 0; @@ -4215,6 +4275,7 @@ #if 0 DEFSUBR (Fmemory_limit); #endif + DEFSUBR (Fmemory_usage); DEFSUBR (Fconsing_since_gc); } @@ -4236,6 +4297,25 @@ See also `consing-since-gc'. */ ); + DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* +*Percentage of memory allocated between garbage collections. + +Garbage collection will happen if this percentage of the total amount of +memory used for data has been allocated since the last garbage collection. +However, it will not happen if less than `gc-cons-threshold' bytes have +been allocated -- this sets an absolute minimum in case very little data +has been allocated or the percentage is set very low. Set this to 0 to +have garbage collection always happen after `gc-cons-threshold' bytes have +been allocated, regardless of current memory usage. + +Garbage collection happens automatically when `eval' or `funcall' are +called. (Note that `funcall' is called implicitly as part of evaluation.) +By binding this temporarily to a large number, you can effectively +prevent garbage collection during a part of the program. + +See also `consing-since-gc'. +*/ ); + #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated.
--- a/src/bytecode.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/bytecode.c Mon Apr 01 03:59:04 2002 +0000 @@ -1,6 +1,7 @@ /* Execution of byte code produced by bytecomp.el. Implementation of compiled-function objects. Copyright (C) 1992, 1993 Free Software Foundation, Inc. + Copyright (C) 1995 Ben Wing. This file is part of XEmacs. @@ -2336,7 +2337,7 @@ return function; } abort (); - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ } DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /*
--- a/src/chartab.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/chartab.c Mon Apr 01 03:59:04 2002 +0000 @@ -214,7 +214,7 @@ #endif invalid_constant ("Unrecognized char table type", symbol); - return CHAR_TABLE_TYPE_GENERIC; /* not reached */ + RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC) } static void @@ -926,7 +926,7 @@ abort (); } - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ } static int @@ -977,7 +977,7 @@ abort (); } - return 0; /* not reached */ + return 0; /* not (usually) reached */ } static Lisp_Object
--- a/src/data.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/data.c Mon Apr 01 03:59:04 2002 +0000 @@ -740,7 +740,7 @@ range_error: args_out_of_range (array, index_); - return Qnil; /* not reached */ + RETURN_NOT_REACHED (Qnil) } DEFUN ("aset", Faset, 3, 3, 0, /* @@ -793,7 +793,7 @@ range_error: args_out_of_range (array, index_); - return Qnil; /* not reached */ + RETURN_NOT_REACHED (Qnil) } @@ -1265,7 +1265,7 @@ divide_by_zero: Fsignal (Qarith_error, Qnil); - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ } DEFUN ("max", Fmax, 1, MANY, 0, /* @@ -1490,7 +1490,7 @@ divide_by_zero: Fsignal (Qarith_error, Qnil); - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ } DEFUN ("ash", Fash, 2, 2, 0, /* @@ -1913,7 +1913,7 @@ if (EQ (symbol, Qfull_assoc)) return WEAK_LIST_FULL_ASSOC; invalid_constant ("Invalid weak list type", symbol); - return WEAK_LIST_SIMPLE; /* not reached */ + RETURN_NOT_REACHED (WEAK_LIST_SIMPLE) } static Lisp_Object @@ -1930,7 +1930,7 @@ abort (); } - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ } DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /*
--- a/src/elhash.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/elhash.c Mon Apr 01 03:59:04 2002 +0000 @@ -617,7 +617,7 @@ if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; invalid_constant ("Invalid hash table weakness", obj); - return HASH_TABLE_NON_WEAK; /* not reached */ + RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK) } static int @@ -643,7 +643,7 @@ if (EQ (obj, Qeql)) return HASH_TABLE_EQL; invalid_constant ("Invalid hash table test", obj); - return HASH_TABLE_EQ; /* not reached */ + RETURN_NOT_REACHED (HASH_TABLE_EQ) } static int
--- a/src/emacs.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/emacs.c Mon Apr 01 03:59:04 2002 +0000 @@ -2612,7 +2612,7 @@ report_sheap_usage (0); #endif LONGJMP (run_temacs_catch, 1); - return Qnil; /* not reached; warning suppression */ + RETURN_NOT_REACHED (Qnil) } /* ARGSUSED */ @@ -2755,7 +2755,7 @@ __except (mswindows_handle_hardware_exceptions (GetExceptionCode ())) {} #endif - return 0; /* unreached */ + RETURN_NOT_REACHED (0) }
--- a/src/eval.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/eval.c Mon Apr 01 03:59:04 2002 +0000 @@ -32,12 +32,6 @@ #include "console.h" #include "opaque.h" -#ifdef ERROR_CHECK_GC -int always_gc; /* Debugging hack */ -#else -#define always_gc 0 -#endif - struct backtrace *backtrace_list; /* Note: you must always fill in all of the fields in a backtrace structure @@ -3213,7 +3207,7 @@ } QUIT; - if ((consing_since_gc > gc_cons_threshold) || always_gc) + if (need_to_garbage_collect ()) { struct gcpro gcpro1; GCPRO1 (form); @@ -3437,7 +3431,7 @@ Lisp_Object *fun_args = args + 1; QUIT; - if ((consing_since_gc > gc_cons_threshold) || always_gc) + if (need_to_garbage_collect ()) /* Callers should gcpro lexpr args */ garbage_collect_1 ();
--- a/src/event-Xt.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/event-Xt.c Mon Apr 01 03:59:04 2002 +0000 @@ -1087,7 +1087,7 @@ bufsiz = len+1; goto Lookup_String; } - return Qnil; /* not reached */ + return Qnil; /* not (usually) reached */ #endif /* HAVE_XIM */ }
--- a/src/event-unixoid.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/event-unixoid.c Mon Apr 01 03:59:04 2002 +0000 @@ -3,7 +3,7 @@ Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -239,7 +239,7 @@ /* else, we got interrupted by a signal, so try again. */ } - RETURN_NOT_REACHED(0) /* not reached */ + RETURN_NOT_REACHED (0) } /****************************************************************************/
--- a/src/extents.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/extents.c Mon Apr 01 03:59:04 2002 +0000 @@ -4253,7 +4253,7 @@ if (EQ (at_flag, Qat)) return EXTENT_AT_AT; invalid_constant ("Invalid AT-FLAG in `extent-at'", at_flag); - return EXTENT_AT_AFTER; /* unreached */ + RETURN_NOT_REACHED (EXTENT_AT_AFTER) } static int @@ -5058,7 +5058,7 @@ if (EQ (layout_obj, Qtext)) return GL_TEXT; invalid_constant ("Unknown glyph layout type", layout_obj); - return GL_TEXT; /* unreached */ + RETURN_NOT_REACHED (GL_TEXT) } static Lisp_Object
--- a/src/file-coding.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/file-coding.c Mon Apr 01 03:59:04 2002 +0000 @@ -985,7 +985,7 @@ if (EQ (symbol, Qcr)) return EOL_CR; invalid_constant ("Unrecognized eol type", symbol); - return EOL_AUTODETECT; /* not reached */ + RETURN_NOT_REACHED (EOL_AUTODETECT) } static Lisp_Object @@ -1697,7 +1697,7 @@ return aliasee; else invalid_argument ("Symbol is not a coding system alias", alias); - return Qnil; /* To keep the compiler happy */ + RETURN_NOT_REACHED (Qnil) } /* A maphash function, for removing dangling coding system aliases. */ @@ -3398,7 +3398,7 @@ } invalid_constant ("Unrecognized coding category", symbol); - return 0; /* not reached */ + RETURN_NOT_REACHED (0) } static Lisp_Object
--- a/src/fileio.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/fileio.c Mon Apr 01 03:59:04 2002 +0000 @@ -143,7 +143,7 @@ errdata = Fcons (build_msg_string (string), Fcons (oserrmess, errdata)); signal_error_1 (errtype, errdata); - UNGCPRO; /* not reached */ + /* UNGCPRO; not reached */ } DOESNT_RETURN @@ -1639,8 +1639,7 @@ syntax_error_2 ("Substituting nonexistent environment variable", filename, build_intstring (target)); - /* NOTREACHED */ - return Qnil; /* suppress compiler warning */ + RETURN_NOT_REACHED (Qnil) } /* A slightly faster and more convenient way to get
--- a/src/fns.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/fns.c Mon Apr 01 03:59:04 2002 +0000 @@ -300,6 +300,52 @@ !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil; } +DEFUN ("compare-strings", Fcompare_strings, 6, 7, 0, /* +Compare the contents of two strings, maybe ignoring case. +In string STR1, skip the first START1 characters and stop at END1. +In string STR2, skip the first START2 characters and stop at END2. +END1 and END2 default to the full lengths of the respective strings. + +Case is significant in this comparison if IGNORE-CASE is nil. + +The value is t if the strings (or specified portions) match. +If string STR1 is less, the value is a negative number N; + - 1 - N is the number of characters that match at the beginning. +If string STR1 is greater, the value is a positive number N; + N - 1 is the number of characters that match at the beginning. +*/ + (str1, start1, end1, str2, start2, end2, ignore_case)) +{ + Charcount ccstart1, ccend1, ccstart2, ccend2; + Bytecount bstart1, blen1, bstart2, blen2; + Charcount matching; + int res; + + CHECK_STRING (str1); + CHECK_STRING (str2); + get_string_range_char (str1, start1, end1, &ccstart1, &ccend1, + GB_HISTORICAL_STRING_BEHAVIOR); + get_string_range_char (str2, start2, end2, &ccstart2, &ccend2, + GB_HISTORICAL_STRING_BEHAVIOR); + + bstart1 = string_index_char_to_byte (str1, ccstart1); + blen1 = string_offset_char_to_byte_len (str1, bstart1, ccend1 - ccstart1); + bstart2 = string_index_char_to_byte (str2, ccstart2); + blen2 = string_offset_char_to_byte_len (str2, bstart2, ccend2 - ccstart2); + + res = ((NILP (ignore_case) ? qxetextcmp_matching : qxetextcasecmp_matching) + (XSTRING_DATA (str1) + bstart1, blen1, + XSTRING_DATA (str2) + bstart2, blen2, + &matching)); + + if (!res) + return Qt; + else if (res > 0) + return make_int (1 + matching); + else + return make_int (-1 - matching); +} + DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* Return t if first arg string is less than second in lexicographic order. Comparison is simply done on a character-by-character basis using the @@ -2743,6 +2789,36 @@ return 0; } +int +internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + if (depth > 200) + stack_overflow ("Stack overflow in equalp", Qunbound); + QUIT; + if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) + return 1; + if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2))) + return extract_float (obj1) == extract_float (obj2); + if (CHARP (obj1) && CHARP (obj2)) + return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2)); + if (XTYPE (obj1) != XTYPE (obj2)) + return 0; + if (LRECORDP (obj1)) + { + const struct lrecord_implementation + *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), + *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); + + /* #### not yet implemented properly, needs another flag to specify + equalp-ness */ + return (imp1 == imp2) && + /* EQ-ness of the objects was noticed above */ + (imp1->equal && (imp1->equal) (obj1, obj2, depth)); + } + + return 0; +} + /* Note that we may be calling sub-objects that will use internal_equal() (instead of internal_old_equal()). Oh well. We will get an Ebola note if there's any possibility of confusion, @@ -3888,6 +3964,7 @@ DEFSUBR (Flength); DEFSUBR (Fsafe_length); DEFSUBR (Fstring_equal); + DEFSUBR (Fcompare_strings); DEFSUBR (Fstring_lessp); DEFSUBR (Fstring_modified_tick); DEFSUBR (Fappend);
--- a/src/glyphs.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/glyphs.c Mon Apr 01 03:59:04 2002 +0000 @@ -406,7 +406,7 @@ invalid_argument ("Unable to interpret glyph instantiator", data); - return Qnil; + RETURN_NOT_REACHED (Qnil) } Lisp_Object
--- a/src/gutter.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/gutter.c Mon Apr 01 03:59:04 2002 +0000 @@ -730,7 +730,7 @@ if (EQ (position, Qright)) return RIGHT_GUTTER; invalid_constant ("Invalid gutter position", position); - return TOP_GUTTER; /* not reached */ + RETURN_NOT_REACHED (TOP_GUTTER) } DEFUN ("set-default-gutter-position", Fset_default_gutter_position, 1, 1, 0, /*
--- a/src/lisp-union.h Sun Mar 31 08:30:17 2002 +0000 +++ b/src/lisp-union.h Mon Apr 01 03:59:04 2002 +0000 @@ -94,8 +94,21 @@ return obj; } + +#ifdef __cplusplus + +#define volatile_make_int(val) make_int (val) + +#else + /* Ugh, need different definition to avoid compiler complaint in - unix_send_process() */ + unix_send_process(). Furthermore, there's no way under C++, it seems, + to declare something volatile and then return it. Perhaps I'd have to + assign to something else instead? But in any case, the warnings about + volatile clobbering doesn't occur in C++. I bet the thing is that C++ + already has a built-in system for dealing with non-local exits and such, + in a smart way that doesn't clobber registers, and incorporates + longjmp() into that. */ INLINE_HEADER Lisp_Object volatile_make_int (EMACS_INT val); INLINE_HEADER Lisp_Object volatile_make_int (EMACS_INT val) @@ -106,6 +119,9 @@ return obj; } +#endif /* __cplusplus */ + + INLINE_HEADER Lisp_Object make_char (Emchar val); INLINE_HEADER Lisp_Object make_char (Emchar val)
--- a/src/lisp.h Sun Mar 31 08:30:17 2002 +0000 +++ b/src/lisp.h Mon Apr 01 03:59:04 2002 +0000 @@ -201,6 +201,7 @@ #ifndef DOESNT_RETURN # if defined __GNUC__ # if ((__GNUC__ > 2) || (__GNUC__ == 2) && (__GNUC_MINOR__ >= 5)) +# define RETURN_NOT_REACHED(value) # define DOESNT_RETURN void # define DECLARE_DOESNT_RETURN(decl) \ extern void decl __attribute__ ((noreturn)) @@ -229,9 +230,14 @@ #if defined __SUNPRO_C || defined __USLC__ #define RETURN_SANS_WARNINGS if (1) return #define RETURN_NOT_REACHED(value) -#else +#endif + +#ifndef RETURN_NOT_REACHED +#define RETURN_NOT_REACHED(value) return value; +#endif + +#ifndef RETURN_SANS_WARNINGS #define RETURN_SANS_WARNINGS return -#define RETURN_NOT_REACHED(value) return value; #endif #ifndef DO_NOTHING @@ -2301,14 +2307,6 @@ /* Garbage collection / GC-protection */ /************************************************************************/ -/* number of bytes of structure consed since last GC */ - -extern EMACS_INT consing_since_gc; - -/* threshold for doing another gc */ - -extern Fixnum gc_cons_threshold; - /* Structure for recording stack slots that need marking */ /* This is a chain of structures, each of which points at a Lisp_Object @@ -2698,6 +2696,7 @@ int object_dead_p (Lisp_Object); void mark_object (Lisp_Object obj); int marked_p (Lisp_Object obj); +int need_to_garbage_collect (void); #ifdef MEMORY_USAGE_STATS Bytecount malloced_storage_size (void *, Bytecount, struct overhead_stats *); @@ -3207,6 +3206,7 @@ Lisp_Object, int, Error_Behavior); int external_remprop (Lisp_Object *, Lisp_Object, int, Error_Behavior); int internal_equal (Lisp_Object, Lisp_Object, int); +int internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth); Lisp_Object concat2 (Lisp_Object, Lisp_Object); Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object vconcat2 (Lisp_Object, Lisp_Object); @@ -3759,8 +3759,21 @@ int ascii_strncasecmp (const Char_ASCII *s1, const Char_ASCII *s2, Bytecount len); int qxememcmp (const Intbyte *s1, const Intbyte *s2, Bytecount len); +int qxememcmp4 (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2); int qxememcasecmp (const Intbyte *s1, const Intbyte *s2, Bytecount len); -int qxememcasecmp_i18n (const Intbyte *s1, const Intbyte *s2, Bytecount len); +int qxememcasecmp4 (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2); +int qxetextcmp (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2); +int qxetextcmp_matching (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2, + Charcount *matching); +int qxetextcasecmp (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2); +int qxetextcasecmp_matching (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2, + Charcount *matching); void buffer_mule_signal_inserted_region (struct buffer *buf, Charbpos start, Bytecount bytelength,
--- a/src/mule-charset.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/mule-charset.c Mon Apr 01 03:59:04 2002 +0000 @@ -829,7 +829,7 @@ return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj; } invalid_constant ("Unrecognized charset property name", prop); - return Qnil; /* not reached */ + RETURN_NOT_REACHED (Qnil) } DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
--- a/src/nt.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/nt.c Mon Apr 01 03:59:04 2002 +0000 @@ -1538,7 +1538,7 @@ } if (dir_find_handle != INVALID_HANDLE_VALUE && dir_pathname - && qxestrncasecmp_i18n (name, dir_pathname, len) == 0 + && qxestrncasecmp_i18n (dir_pathname, name, len) == 0 && IS_DIRECTORY_SEP (name[len]) && qxestrcasecmp_i18n (name + len + 1, (Intbyte *) dir_static.d_name) == 0)
--- a/src/process-unix.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/process-unix.c Mon Apr 01 03:59:04 2002 +0000 @@ -1115,7 +1115,7 @@ close_descriptor_pair (inchannel, outchannel); errno = save_errno; report_process_error ("Opening pty or pipe", Qunbound); - return 0; /* not reached */ + RETURN_NOT_REACHED (0) } }
--- a/src/process.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/process.c Mon Apr 01 03:59:04 2002 +0000 @@ -1747,7 +1747,7 @@ #undef handle_signal invalid_constant ("Undefined signal name", signal_); - return 0; /* Unreached */ + RETURN_NOT_REACHED (0) } }
--- a/src/specifier.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/specifier.c Mon Apr 01 03:59:04 2002 +0000 @@ -719,7 +719,7 @@ invalid_argument ("Invalid specifier locale type", locale_type); - return LOCALE_GLOBAL; /* not reached */ + RETURN_NOT_REACHED (LOCALE_GLOBAL) } Lisp_Object @@ -1339,7 +1339,7 @@ invalid_constant ("Invalid `how-to-add' flag", how_to_add); - return SPEC_PREPEND; /* not reached */ + RETURN_NOT_REACHED (SPEC_PREPEND) } /* Given a specifier object SPEC, return bodily specifier if SPEC is a
--- a/src/symbols.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/symbols.c Mon Apr 01 03:59:04 2002 +0000 @@ -2835,8 +2835,7 @@ if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL; invalid_constant ("Unrecognized symbol value handler type", symbol); - abort (); - return MAGIC_HANDLER_MAX; + RETURN_NOT_REACHED (MAGIC_HANDLER_MAX) } static enum lisp_magic_handler @@ -2870,7 +2869,7 @@ if (abort_if_not_found) abort (); invalid_argument ("Unrecognized symbol-value function", funsym); - return MAGIC_HANDLER_MAX; + RETURN_NOT_REACHED (MAGIC_HANDLER_MAX) } static int
--- a/src/sysdep.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/sysdep.c Mon Apr 01 03:59:04 2002 +0000 @@ -2134,15 +2134,15 @@ /* limits of text/data segments */ /************************************************************************/ -#if !defined(CANNOT_DUMP) && !defined(PDUMP) +/* Need start_of_data() as much as possible now, for total_data_usage(); + but with PDUMP and WIN32_NATIVE, can't currently do it. */ +#if !defined (CANNOT_DUMP) && (!defined (PDUMP) || !defined (WIN32_NATIVE)) #define NEED_STARTS #endif -#ifndef SYSTEM_MALLOC -#ifndef NEED_STARTS +#if !defined (SYSTEM_MALLOC) && !defined (NEED_STARTS) #define NEED_STARTS #endif -#endif #ifdef NEED_STARTS /* Some systems that cannot dump also cannot implement these. */ @@ -2154,7 +2154,7 @@ * */ -#if !defined(HAVE_TEXT_START) && !defined(PDUMP) +#if !defined (HAVE_TEXT_START) && !defined (PDUMP) EXTERN_C int _start (void); @@ -2195,7 +2195,7 @@ * */ -#if defined(ORDINARY_LINK) && !defined(MINGW) +#if defined (ORDINARY_LINK) && !defined (MINGW) extern char **environ; #endif @@ -2217,7 +2217,7 @@ if (!initialized) return static_heap_base; #endif - return((char *) &environ); + return ((char *) &environ); #else extern int data_start; return ((char *) &data_start); @@ -2226,6 +2226,55 @@ } #endif /* NEED_STARTS (not CANNOT_DUMP or not SYSTEM_MALLOC) */ +extern void *minimum_address_seen; /* from xmalloc() */ +extern void *maximum_address_seen; /* from xmalloc() */ + +extern EMACS_INT consing_since_gc; + +Bytecount +total_data_usage (void) +{ + static EMACS_INT last_consing_since_gc; + static void *last_sbrk; + +#ifdef NEED_STARTS + void *data_start = start_of_data (); +#else + void *data_start = minimum_address_seen; +#endif + +#if !defined (WIN32_NATIVE) && !defined (CYGWIN) + void *data_end; + + /* Random hack to avoid calling sbrk constantly (every funcall). #### Is + it worth it? */ + if (!last_sbrk || !(consing_since_gc >= last_consing_since_gc && + (consing_since_gc - last_consing_since_gc) < 1000)) + { + last_sbrk = sbrk (0); + last_consing_since_gc = consing_since_gc; + } + data_end = last_sbrk; +#else + void *data_end = maximum_address_seen; +#endif + + /* Sanity checking -- the min determined by malloc() should always be + greater than data start determined by other means. We could do the + same check on the max, except that things like rel-alloc might + invalidate it. */ + if (minimum_address_seen && + (char *) minimum_address_seen < (char *) data_start) + data_start = minimum_address_seen; + + if (data_end < data_start) /* Huh?????????? */ + data_end = maximum_address_seen; + + /* #### Doesn't seem to give good results on Windows; values are much + higher than actual memory usage. How to fix??? */ + return (char *) data_end - (char *) data_start; +} + /************************************************************************/ /* get the system name */
--- a/src/sysdep.h Sun Mar 31 08:30:17 2002 +0000 +++ b/src/sysdep.h Mon Apr 01 03:59:04 2002 +0000 @@ -140,4 +140,6 @@ void *sbrk (unsigned long increment); #endif +Bytecount total_data_usage (void); + #endif /* INCLUDED_sysdep_h_ */
--- a/src/text.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/text.c Mon Apr 01 03:59:04 2002 +0000 @@ -739,10 +739,17 @@ return qxestrncasecmp (s1, (const Intbyte *) s2, len); } +/* Compare LEN_FROM_S1 worth of characters from S1 with the same number of + characters from S2, case insensitive. NOTE: Downcasing can convert + characters from one length in bytes to another, so reversing S1 and S2 + is *NOT* a symmetric operations! You must choose a length that agrees + with S1. */ + int -qxestrncasecmp_i18n (const Intbyte *s1, const Intbyte *s2, Bytecount len) +qxestrncasecmp_i18n (const Intbyte *s1, const Intbyte *s2, + Bytecount len_from_s1) { - while (len > 0) + while (len_from_s1 > 0) { const Intbyte *old_s1 = s1; int diff = (DOWNCASE (0, charptr_emchar (s1)) - @@ -753,7 +760,7 @@ return 0; INC_CHARPTR (s1); INC_CHARPTR (s2); - len -= s1 - old_s1; + len_from_s1 -= s1 - old_s1; } return 0; @@ -766,6 +773,16 @@ } int +qxememcmp4 (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2) +{ + int retval = qxememcmp (s1, s2, min (len1, len2)); + if (retval) + return retval; + return len1 - len2; +} + +int qxememcasecmp (const Intbyte *s1, const Intbyte *s2, Bytecount len) { Intbyte *cm = strcasecmp_charmap; @@ -782,21 +799,122 @@ } int -qxememcasecmp_i18n (const Intbyte *s1, const Intbyte *s2, Bytecount len) +qxememcasecmp4 (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2) { - while (len > 0) + int retval = qxememcasecmp (s1, s2, min (len1, len2)); + if (retval) + return retval; + return len1 - len2; +} + +/* Do a character-by-character comparison, returning "which is greater" by + comparing the Emchar values. (#### Should have option to compare Unicode + points) */ + +int +qxetextcmp (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2) +{ + while (len1 > 0 && len2 > 0) { const Intbyte *old_s1 = s1; + const Intbyte *old_s2 = s2; + int diff = charptr_emchar (s1) - charptr_emchar (s2); + if (diff != 0) + return diff; + INC_CHARPTR (s1); + INC_CHARPTR (s2); + len1 -= s1 - old_s1; + len2 -= s2 - old_s2; + } + + assert (len1 >= 0 && len2 >= 0); + return len1 - len2; +} + +int +qxetextcmp_matching (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2, + Charcount *matching) +{ + *matching = 0; + while (len1 > 0 && len2 > 0) + { + const Intbyte *old_s1 = s1; + const Intbyte *old_s2 = s2; + int diff = charptr_emchar (s1) - charptr_emchar (s2); + if (diff != 0) + return diff; + INC_CHARPTR (s1); + INC_CHARPTR (s2); + len1 -= s1 - old_s1; + len2 -= s2 - old_s2; + (*matching)++; + } + + assert (len1 >= 0 && len2 >= 0); + return len1 - len2; +} + +/* Do a character-by-character comparison, returning "which is greater" by + comparing the Emchar values, case insensitively (by downcasing both + first). (#### Should have option to compare Unicode points) + + In this case, both lengths must be specified becaused downcasing can + convert characters from one length in bytes to another; therefore, two + blocks of text of different length might be equal. If both compare + equal up to the limit in length of one but not the other, the longer one + is "greater". */ + +int +qxetextcasecmp (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2) +{ + while (len1 > 0 && len2 > 0) + { + const Intbyte *old_s1 = s1; + const Intbyte *old_s2 = s2; int diff = (DOWNCASE (0, charptr_emchar (s1)) - DOWNCASE (0, charptr_emchar (s2))); if (diff != 0) return diff; INC_CHARPTR (s1); INC_CHARPTR (s2); - len -= s1 - old_s1; + len1 -= s1 - old_s1; + len2 -= s2 - old_s2; } - return 0; + assert (len1 >= 0 && len2 >= 0); + return len1 - len2; +} + +/* Like qxetextcasecmp() but also return number of characters at + beginning that match. */ + +int +qxetextcasecmp_matching (const Intbyte *s1, Bytecount len1, + const Intbyte *s2, Bytecount len2, + Charcount *matching) +{ + *matching = 0; + while (len1 > 0 && len2 > 0) + { + const Intbyte *old_s1 = s1; + const Intbyte *old_s2 = s2; + int diff = (DOWNCASE (0, charptr_emchar (s1)) - + DOWNCASE (0, charptr_emchar (s2))); + if (diff != 0) + return diff; + INC_CHARPTR (s1); + INC_CHARPTR (s2); + len1 -= s1 - old_s1; + len2 -= s2 - old_s2; + (*matching)++; + } + + assert (len1 >= 0 && len2 >= 0); + return len1 - len2; } int @@ -826,29 +944,8 @@ int lisp_strcasecmp_i18n (Lisp_Object s1, Lisp_Object s2) { - Intbyte *p1 = XSTRING_DATA (s1); - Intbyte *p2 = XSTRING_DATA (s2); - Intbyte *e1 = p1 + XSTRING_LENGTH (s1); - Intbyte *e2 = p2 + XSTRING_LENGTH (s2); - - /* again, we use a symmetric algorithm and favor clarity over - nanosecond improvements. */ - while (1) - { - /* if we reached the end of either string, compare lengths. - do NOT compare the final null byte against anything, in case - the other string also has a null byte at that position. */ - assert (p1 <= e1); - assert (p2 <= e2); - if (p1 == e1 || p2 == e2) - return e1 - e2; - if (DOWNCASE (0, charptr_emchar (p1)) != - DOWNCASE (0, charptr_emchar (p2))) - return (DOWNCASE (0, charptr_emchar (p1)) - - DOWNCASE (0, charptr_emchar (p2))); - INC_CHARPTR (p1); - INC_CHARPTR (p2); - } + return qxetextcasecmp (XSTRING_DATA (s1), XSTRING_LENGTH (s1), + XSTRING_DATA (s2), XSTRING_LENGTH (s2)); } @@ -1148,9 +1245,7 @@ { Bytecount dstlen; - int result; const Intbyte *src = ei->data_, *dst; - Bytecount cmplen; if (data) { @@ -1166,15 +1261,9 @@ if (is_c) EI_ASSERT_ASCII ((Char_ASCII *) dst, dstlen); - cmplen = min (len, dstlen); - result = (fold_case == 0 ? qxememcmp (src, dst, cmplen) : - fold_case == 1 ? qxememcasecmp (src, dst, cmplen) : - qxememcasecmp_i18n (src, dst, cmplen)); - - if (result) - return result; - - return len - dstlen; + return (fold_case == 0 ? qxememcmp4 (src, len, dst, dstlen) : + fold_case == 1 ? qxememcasecmp4 (src, len, dst, dstlen) : + qxetextcasecmp (src, len, dst, dstlen)); } }
--- a/src/toolbar.c Sun Mar 31 08:30:17 2002 +0000 +++ b/src/toolbar.c Mon Apr 01 03:59:04 2002 +0000 @@ -223,7 +223,7 @@ if (EQ (position, Qright)) return RIGHT_TOOLBAR; invalid_constant ("Invalid toolbar position", position); - return TOP_TOOLBAR; /* not reached */ + RETURN_NOT_REACHED (TOP_TOOLBAR) } DEFUN ("set-default-toolbar-position", Fset_default_toolbar_position, 1, 1, 0, /*