[PATCH] Conditionalise `old-eq', `old-equal' etc. at compile time.

As I said a few months ago, nothing in our code base provokes the ebola warnings any more (though I think I should have pointed Andreas Roehler to them at some point, he seemed to be affected by char-int confoundance in code he had originally written for GNU Emacs). I’d like to remove thes functions and their byte codes at some point in the future, and this is one step towards that. diff -r 6c3a695f54f5 lisp/ChangeLog --- a/lisp/ChangeLog Mon Mar 14 21:04:45 2011 +0000 +++ b/lisp/ChangeLog Tue Mar 15 21:30:04 2011 +0000 ＠＠ -1,3 +1,10 ＠＠ +2011-03-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * bytecomp.el: + Don't generate the old-eq, old-memq, old-equal bytecodes any more, + but keep the information about them around for the sake of the + disassembler. + 2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * isearch-mode.el (isearch-mode-map): diff -r 6c3a695f54f5 lisp/bytecomp.el --- a/lisp/bytecomp.el Mon Mar 14 21:04:45 2011 +0000 +++ b/lisp/bytecomp.el Tue Mar 15 21:30:04 2011 +0000 ＠＠ -3161,8 +3161,8 ＠＠ (byte-defop-compiler skip-chars-forward 1-2+1) (byte-defop-compiler skip-chars-backward 1-2+1) (byte-defop-compiler eq 2) -(byte-defop-compiler20 old-eq 2) -(byte-defop-compiler20 old-memq 2) +; (byte-defop-compiler20 old-eq 2) +; (byte-defop-compiler20 old-memq 2) (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler get 2+1) ＠＠ -3179,7 +3179,7 ＠＠ (byte-defop-compiler string< 2) (byte-defop-compiler (string-equal byte-string=) 2) (byte-defop-compiler (string-lessp byte-string<) 2) -(byte-defop-compiler20 old-equal 2) +; (byte-defop-compiler20 old-equal 2) (byte-defop-compiler nthcdr 2) (byte-defop-compiler elt 2) (byte-defop-compiler20 old-member 2) diff -r 6c3a695f54f5 man/ChangeLog --- a/man/ChangeLog Mon Mar 14 21:04:45 2011 +0000 +++ b/man/ChangeLog Tue Mar 15 21:30:04 2011 +0000 ＠＠ -1,3 +1,10 ＠＠ +2011-03-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * lispref/objects.texi (Character Type): + * lispref/objects.texi (Equality Predicates): + No longer document `old-eq', `old-equal', they haven't been used + in years. + 2011-03-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * lispref/commands.texi (Using Interactive): diff -r 6c3a695f54f5 man/lispref/objects.texi --- a/man/lispref/objects.texi Mon Mar 14 21:04:45 2011 +0000 +++ b/man/lispref/objects.texi Tue Mar 15 21:30:04 2011 +0000 ＠＠ -349,19 +349,6 ＠＠ primitive types. (This change was necessary in order for ＠sc{mule}, i.e. Asian-language, support to be correctly implemented.) - Even in XEmacs version 20, remnants of the equivalence between -characters and integers still exist; this is termed the ＠dfn{char-int -confoundance disease}. In particular, many functions such as ＠code{eq}, -＠code{equal}, and ＠code{memq} have equivalent functions (＠code{old-eq}, -＠code{old-equal}, ＠code{old-memq}, etc.) that pretend like characters -are integers are the same. Byte code compiled under any version 19 -Emacs will have all such functions mapped to their ＠code{old-} equivalents -when the byte code is read into XEmacs 20. This is to preserve -compatibility---Emacs 19 converts all constant characters to the equivalent -integer during byte-compilation, and thus there is no other way to preserve -byte-code compatibility even if the code has specifically been written -with the distinction between characters and integers in mind. - Every character has an equivalent integer, called the ＠dfn{character code}. For example, the character ＠kbd{A} is represented as the ＠w{integer 65}, following the standard ＠sc{ascii} representation of ＠＠ -2317,32 +2304,6 ＠＠ ＠end defun -＠defun old-eq object1 object2 -This function exists under XEmacs 20 and is exactly like ＠code{eq} -except that it suffers from the char-int confoundance disease. -In other words, it returns ＠code{t} if given a character and the -equivalent integer, even though the objects are of different types! -You should ＠emph{not} ever call this function explicitly in your -code. However, be aware that all calls to ＠code{eq} in byte code -compiled under version 19 map to ＠code{old-eq} in XEmacs 20. -(Likewise for ＠code{old-equal}, ＠code{old-memq}, ＠code{old-member}, -＠code{old-assq} and ＠code{old-assoc}.) - -＠example -＠group -;; ＠r{Remember, this does not apply under XEmacs 19.} -?A - ＠result{} ?A -(char-int ?A) - ＠result{} 65 -(old-eq ?A 65) - ＠result{} t ; ＠r{Eek, we've been infected.} -(eq ?A 65) - ＠result{} nil ; ＠r{We are still healthy.} -＠end group -＠end example -＠end defun - ＠defun eql object1 object2 This function returns ＠code{t} if the two arguments are the same object, diff -r 6c3a695f54f5 src/ChangeLog --- a/src/ChangeLog Mon Mar 14 21:04:45 2011 +0000 +++ b/src/ChangeLog Tue Mar 15 21:30:04 2011 +0000 ＠＠ -1,3 +1,26 ＠＠ +2011-03-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define, + equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether + this XEmacs should support the old-eq, old-equal and related + functions and byte codes. + * bytecode.c (UNUSED): + Only interpret old-eq, old-equal, old-memq if + SUPPORT_CONFOUNDING_FUNCTIONS is defined. + * data.c: + * data.c (syms_of_data): + Wrap Fold_eq with #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. + * fns.c: + * fns.c (Fmemq): + * fns.c (memq_no_quit): + * fns.c (assoc_no_quit): + * fns.c (Frassq): + * fns.c (Fequal): + * fns.c (Fold_equal): + * fns.c (syms_of_fns): + Group old-eq, old-equal, old-memq etc together, surround them with + #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. + 2011-03-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; * glyphs-eimage.c (png_instantiate): diff -r 6c3a695f54f5 src/bytecode.c --- a/src/bytecode.c Mon Mar 14 21:04:45 2011 +0000 +++ b/src/bytecode.c Tue Mar 15 21:30:04 2011 +0000 ＠＠ -1692,6 +1692,8 ＠＠ break; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + case Bold_eq: { Lisp_Object arg = POP; ＠＠ -1727,6 +1729,8 ＠＠ break; } +#endif + case Bbind_multiple_value_limits: { Lisp_Object upper = POP, first = TOP, speccount; diff -r 6c3a695f54f5 src/config.h.in --- a/src/config.h.in Mon Mar 14 21:04:45 2011 +0000 +++ b/src/config.h.in Tue Mar 15 21:30:04 2011 +0000 ＠＠ -1183,4 +1183,6 ＠＠ /* Do we need to be able to run code compiled by and written for 21.4? */ #define NEED_TO_HANDLE_21_4_CODE 1 +#define SUPPORT_CONFOUNDING_FUNCTIONS NEED_TO_HANDLE_21_4_CODE + #endif /* _SRC_CONFIG_H_ */ diff -r 6c3a695f54f5 src/data.c --- a/src/data.c Mon Mar 14 21:04:45 2011 +0000 +++ b/src/data.c Tue Mar 15 21:30:04 2011 +0000 ＠＠ -183,6 +183,8 ＠＠ return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* Return t if the two args are (in most cases) the same Lisp object. ＠＠ -201,6 +203,8 ＠＠ return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil; } +#endif + DEFUN ("null", Fnull, 1, 1, 0, /* Return t if OBJECT is nil. */ ＠＠ -3568,7 +3572,9 ＠＠ DEFSUBR (Fdiv); #endif DEFSUBR (Feq); +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS DEFSUBR (Fold_eq); + DEFSUBR (Fnull); Ffset (intern ("not"), intern ("null")); DEFSUBR (Flistp); diff -r 6c3a695f54f5 src/fns.c --- a/src/fns.c Mon Mar 14 21:04:45 2011 +0000 +++ b/src/fns.c Tue Mar 15 21:30:04 2011 +0000 ＠＠ -72,7 +72,6 ＠＠ extern Fixnum max_lisp_eval_depth; extern int lisp_eval_depth; -static int internal_old_equal (Lisp_Object, Lisp_Object, int); Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); static DOESNT_RETURN ＠＠ -2581,22 +2580,6 ＠＠ return Qnil; } -DEFUN ("old-member", Fold_member, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (internal_old_equal (elt, list_elt, 0)) - return tail; - } - return Qnil; -} - DEFUN ("memq", Fmemq, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. ＠＠ -2611,22 +2594,6 ＠＠ return Qnil; } -DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (HACKEQ_UNSAFE (elt, list_elt)) - return tail; - } - return Qnil; -} - Lisp_Object memq_no_quit (Lisp_Object elt, Lisp_Object list) { ＠＠ -2822,21 +2789,6 ＠＠ return Qnil; } -DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* -Return non-nil if KEY is `old-equal' to the car of an element of ALIST. -The value is actually the element of ALIST whose car equals KEY. -*/ - (key, alist)) -{ - /* This function can GC. */ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (key, elt_car, 0)) - return elt; - } - return Qnil; -} - Lisp_Object assoc_no_quit (Lisp_Object key, Lisp_Object alist) { ＠＠ -2860,23 +2812,6 ＠＠ return Qnil; } -DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* -Return non-nil if KEY is `old-eq' to the car of an element of ALIST. -The value is actually the element of ALIST whose car is KEY. -Elements of ALIST that are not conses are ignored. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (key, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (HACKEQ_UNSAFE (key, elt_car)) - return elt; - } - return Qnil; -} - /* Like Fassq but never report an error and do not allow quits. Use only on lists known never to be circular. */ ＠＠ -2960,20 +2895,6 ＠＠ return Qnil; } -DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* -Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. -The value is actually the element of ALIST whose cdr equals VALUE. -*/ - (value, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (value, elt_cdr, 0)) - return elt; - } - return Qnil; -} - DEFUN ("rassq", Frassq, 2, 2, 0, /* Return non-nil if VALUE is `eq' to the cdr of an element of ALIST. The value is actually the element of ALIST whose cdr is VALUE. ＠＠ -3278,34 +3199,6 ＠＠ return object; }  -DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delete element foo))' to be sure -of changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_old_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (HACKEQ_UNSAFE (elt, list_elt))); - return list; -} - /* Like Fdelq, but caller must ensure that LIST is properly nil-terminated and ebola-free. */ ＠＠ -6537,6 +6430,157 ＠＠ return internal_equal (obj1, obj2, depth); } +DEFUN ("equal", Fequal, 2, 2, 0, /* +Return t if two Lisp objects have similar structure and contents. +They must have the same data type. +Conses are compared by comparing the cars and the cdrs. +Vectors and strings are compared element by element. +Numbers are compared by value. Symbols must match exactly. +*/ + (object1, object2)) +{ + return internal_equal (object1, object2, 0) ? Qt : Qnil; +} + +DEFUN ("equalp", Fequalp, 2, 2, 0, /* +Return t if two Lisp objects have similar structure and contents. + +This is like `equal', except that it accepts numerically equal +numbers of different types (float, integer, bignum, bigfloat), and also +compares strings and characters case-insensitively. + +Type objects that are arrays (that is, strings, bit-vectors, and vectors) +of the same length and with contents that are `equalp' are themselves +`equalp', regardless of whether the two objects have the same type. + +Other objects whose primary purpose is as containers of other objects are +`equalp' if they would otherwise be equal (same length, type, etc.) and +their contents are `equalp'. This goes for conses, weak lists, +weak boxes, ephemerons, specifiers, hash tables, char tables and range +tables. However, objects that happen to contain other objects but are not +primarily designed for this purpose (e.g. compiled functions, events or +display-related objects such as glyphs, faces or extents) are currently +compared using `equalp' the same way as using `equal'. + +More specifically, two hash tables are `equalp' if they have the same test +(see `hash-table-test'), the same number of entries, and the same value for +`hash-table-weakness', and if, for each entry in one hash table, its key is +equivalent to a key in the other hash table using the hash table test, and +its value is `equalp' to the other hash table's value for that key. +*/ + (object1, object2)) +{ + return internal_equalp (object1, object2, 0) ? Qt : Qnil; +} + +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + +DEFUN ("old-member", Fold_member, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (internal_old_equal (elt, list_elt, 0)) + return tail; + } + return Qnil; +} + +DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (HACKEQ_UNSAFE (elt, list_elt)) + return tail; + } + return Qnil; +} + +DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* +Return non-nil if KEY is `old-equal' to the car of an element of ALIST. +The value is actually the element of ALIST whose car equals KEY. +*/ + (key, alist)) +{ + /* This function can GC. */ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (key, elt_car, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* +Return non-nil if KEY is `old-eq' to the car of an element of ALIST. +The value is actually the element of ALIST whose car is KEY. +Elements of ALIST that are not conses are ignored. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (key, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (HACKEQ_UNSAFE (key, elt_car)) + return elt; + } + return Qnil; +} + +DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* +Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. +The value is actually the element of ALIST whose cdr equals VALUE. +*/ + (value, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (value, elt_cdr, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-equal'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delete element foo))' to be sure +of changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (internal_old_equal (elt, list_elt, 0))); + return list; +} + +DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-eq'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delq element foo))' to be sure of +changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (HACKEQ_UNSAFE (elt, list_elt))); + return list; +} + /* 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, ＠＠ -6557,49 +6601,6 ＠＠ return internal_equal (obj1, obj2, depth); } -DEFUN ("equal", Fequal, 2, 2, 0, /* -Return t if two Lisp objects have similar structure and contents. -They must have the same data type. -Conses are compared by comparing the cars and the cdrs. -Vectors and strings are compared element by element. -Numbers are compared by value. Symbols must match exactly. -*/ - (object1, object2)) -{ - return internal_equal (object1, object2, 0) ? Qt : Qnil; -} - -DEFUN ("equalp", Fequalp, 2, 2, 0, /* -Return t if two Lisp objects have similar structure and contents. - -This is like `equal', except that it accepts numerically equal -numbers of different types (float, integer, bignum, bigfloat), and also -compares strings and characters case-insensitively. - -Type objects that are arrays (that is, strings, bit-vectors, and vectors) -of the same length and with contents that are `equalp' are themselves -`equalp', regardless of whether the two objects have the same type. - -Other objects whose primary purpose is as containers of other objects are -`equalp' if they would otherwise be equal (same length, type, etc.) and -their contents are `equalp'. This goes for conses, weak lists, -weak boxes, ephemerons, specifiers, hash tables, char tables and range -tables. However, objects that happen to contain other objects but are not -primarily designed for this purpose (e.g. compiled functions, events or -display-related objects such as glyphs, faces or extents) are currently -compared using `equalp' the same way as using `equal'. - -More specifically, two hash tables are `equalp' if they have the same test -(see `hash-table-test'), the same number of entries, and the same value for -`hash-table-weakness', and if, for each entry in one hash table, its key is -equivalent to a key in the other hash table using the hash table test, and -its value is `equalp' to the other hash table's value for that key. -*/ - (object1, object2)) -{ - return internal_equalp (object1, object2, 0) ? Qt : Qnil; -} - DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. ＠＠ -6614,6 +6615,8 ＠＠ return internal_old_equal (object1, object2, 0) ? Qt : Qnil; } +#endif +  static Lisp_Object replace_string_range_1 (Lisp_Object dest, Lisp_Object start, ＠＠ -11798,25 +11801,17 ＠＠ DEFSUBR (Fbutlast); DEFSUBR (Fnbutlast); DEFSUBR (Fmember); - DEFSUBR (Fold_member); DEFSUBR (Fmemq); - DEFSUBR (Fold_memq); DEFSUBR (FmemberX); DEFSUBR (Fadjoin); DEFSUBR (Fassoc); - DEFSUBR (Fold_assoc); DEFSUBR (Fassq); - DEFSUBR (Fold_assq); DEFSUBR (Frassoc); - DEFSUBR (Fold_rassoc); DEFSUBR (Frassq); - DEFSUBR (Fold_rassq); DEFSUBR (Fposition); DEFSUBR (Ffind); - DEFSUBR (Fold_delete); - DEFSUBR (Fold_delq); DEFSUBR (FdeleteX); DEFSUBR (FremoveX); DEFSUBR (Fremassoc); ＠＠ -11853,8 +11848,19 ＠＠ DEFSUBR (Fobject_setplist); DEFSUBR (Fequal); DEFSUBR (Fequalp); + DEFSUBR (Ffill); + +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + DEFSUBR (Fold_member); + DEFSUBR (Fold_memq); + DEFSUBR (Fold_assoc); + DEFSUBR (Fold_assq); + DEFSUBR (Fold_rassoc); + DEFSUBR (Fold_rassq); + DEFSUBR (Fold_delete); + DEFSUBR (Fold_delq); DEFSUBR (Fold_equal); - DEFSUBR (Ffill); +#endif DEFSUBR (FassocX); DEFSUBR (FrassocX); -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches