comparison src/fns.c @ 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 e38acbeb1cae
children a634e3b7acc8
comparison
equal deleted inserted replaced
800:a5954632b187 801:2b676dc88c66
296 p2 = string2; 296 p2 = string2;
297 } 297 }
298 298
299 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) && 299 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) &&
300 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil; 300 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil;
301 }
302
303 DEFUN ("compare-strings", Fcompare_strings, 6, 7, 0, /*
304 Compare the contents of two strings, maybe ignoring case.
305 In string STR1, skip the first START1 characters and stop at END1.
306 In string STR2, skip the first START2 characters and stop at END2.
307 END1 and END2 default to the full lengths of the respective strings.
308
309 Case is significant in this comparison if IGNORE-CASE is nil.
310
311 The value is t if the strings (or specified portions) match.
312 If string STR1 is less, the value is a negative number N;
313 - 1 - N is the number of characters that match at the beginning.
314 If string STR1 is greater, the value is a positive number N;
315 N - 1 is the number of characters that match at the beginning.
316 */
317 (str1, start1, end1, str2, start2, end2, ignore_case))
318 {
319 Charcount ccstart1, ccend1, ccstart2, ccend2;
320 Bytecount bstart1, blen1, bstart2, blen2;
321 Charcount matching;
322 int res;
323
324 CHECK_STRING (str1);
325 CHECK_STRING (str2);
326 get_string_range_char (str1, start1, end1, &ccstart1, &ccend1,
327 GB_HISTORICAL_STRING_BEHAVIOR);
328 get_string_range_char (str2, start2, end2, &ccstart2, &ccend2,
329 GB_HISTORICAL_STRING_BEHAVIOR);
330
331 bstart1 = string_index_char_to_byte (str1, ccstart1);
332 blen1 = string_offset_char_to_byte_len (str1, bstart1, ccend1 - ccstart1);
333 bstart2 = string_index_char_to_byte (str2, ccstart2);
334 blen2 = string_offset_char_to_byte_len (str2, bstart2, ccend2 - ccstart2);
335
336 res = ((NILP (ignore_case) ? qxetextcmp_matching : qxetextcasecmp_matching)
337 (XSTRING_DATA (str1) + bstart1, blen1,
338 XSTRING_DATA (str2) + bstart2, blen2,
339 &matching));
340
341 if (!res)
342 return Qt;
343 else if (res > 0)
344 return make_int (1 + matching);
345 else
346 return make_int (-1 - matching);
301 } 347 }
302 348
303 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* 349 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /*
304 Return t if first arg string is less than second in lexicographic order. 350 Return t if first arg string is less than second in lexicographic order.
305 Comparison is simply done on a character-by-character basis using the 351 Comparison is simply done on a character-by-character basis using the
2741 } 2787 }
2742 2788
2743 return 0; 2789 return 0;
2744 } 2790 }
2745 2791
2792 int
2793 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth)
2794 {
2795 if (depth > 200)
2796 stack_overflow ("Stack overflow in equalp", Qunbound);
2797 QUIT;
2798 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
2799 return 1;
2800 if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2)))
2801 return extract_float (obj1) == extract_float (obj2);
2802 if (CHARP (obj1) && CHARP (obj2))
2803 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2));
2804 if (XTYPE (obj1) != XTYPE (obj2))
2805 return 0;
2806 if (LRECORDP (obj1))
2807 {
2808 const struct lrecord_implementation
2809 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
2810 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
2811
2812 /* #### not yet implemented properly, needs another flag to specify
2813 equalp-ness */
2814 return (imp1 == imp2) &&
2815 /* EQ-ness of the objects was noticed above */
2816 (imp1->equal && (imp1->equal) (obj1, obj2, depth));
2817 }
2818
2819 return 0;
2820 }
2821
2746 /* Note that we may be calling sub-objects that will use 2822 /* Note that we may be calling sub-objects that will use
2747 internal_equal() (instead of internal_old_equal()). Oh well. 2823 internal_equal() (instead of internal_old_equal()). Oh well.
2748 We will get an Ebola note if there's any possibility of confusion, 2824 We will get an Ebola note if there's any possibility of confusion,
2749 but that seems unlikely. */ 2825 but that seems unlikely. */
2750 2826
3886 DEFSUBR (Fidentity); 3962 DEFSUBR (Fidentity);
3887 DEFSUBR (Frandom); 3963 DEFSUBR (Frandom);
3888 DEFSUBR (Flength); 3964 DEFSUBR (Flength);
3889 DEFSUBR (Fsafe_length); 3965 DEFSUBR (Fsafe_length);
3890 DEFSUBR (Fstring_equal); 3966 DEFSUBR (Fstring_equal);
3967 DEFSUBR (Fcompare_strings);
3891 DEFSUBR (Fstring_lessp); 3968 DEFSUBR (Fstring_lessp);
3892 DEFSUBR (Fstring_modified_tick); 3969 DEFSUBR (Fstring_modified_tick);
3893 DEFSUBR (Fappend); 3970 DEFSUBR (Fappend);
3894 DEFSUBR (Fconcat); 3971 DEFSUBR (Fconcat);
3895 DEFSUBR (Fvconcat); 3972 DEFSUBR (Fvconcat);