diff src/fns.c @ 5374:d967d96ca043

Conditionalise the old-* functions and byte codes at compile time. src/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * 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: Move Fold_eq to fns.c with the rest of the Fold_* 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. lisp/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * 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. man/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * lispref/objects.texi (Character Type): * lispref/objects.texi (Equality Predicates): No longer document `old-eq', `old-equal', they haven't been used in years. tests/ChangeLog addition: 2011-03-17 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Only test the various old-* function if old-eq is bound and a subr.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 17 Mar 2011 20:13:00 +0000
parents 46b53e84ea7a
children e99b473303e3 ac37a5f7e5be
line wrap: on
line diff
--- a/src/fns.c	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/fns.c	Thu Mar 17 20:13:00 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,26 +6430,6 @@
     return internal_equal (obj1, obj2, depth);
 }
 
-/* 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,
-   but that seems unlikely. */
-
-static int
-internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
-  if (depth + lisp_eval_depth > max_lisp_eval_depth)
-    stack_overflow ("Stack overflow in equal", Qunbound);
-  QUIT;
-  if (HACKEQ_UNSAFE (obj1, obj2))
-    return 1;
-  /* Note that (equal 20 20.0) should be nil */
-  if (XTYPE (obj1) != XTYPE (obj2))
-    return 0;
-
-  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.
@@ -6600,6 +6473,134 @@
   return internal_equalp (object1, object2, 0) ? Qt : Qnil;
 }
 
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
+
+/* 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,
+   but that seems unlikely. */
+
+static int
+internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+  if (depth + lisp_eval_depth > max_lisp_eval_depth)
+    stack_overflow ("Stack overflow in equal", Qunbound);
+  QUIT;
+  if (HACKEQ_UNSAFE (obj1, obj2))
+    return 1;
+  /* Note that (equal 20 20.0) should be nil */
+  if (XTYPE (obj1) != XTYPE (obj2))
+    return 0;
+
+  return internal_equal (obj1, obj2, depth);
+}
+
+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;
+}
+
 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,26 @@
   return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
 }
 
+DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
+Return t if the two args are (in most cases) the same Lisp object.
+
+Special kludge: A character is considered `old-eq' to its equivalent integer
+even though they are not the same object and are in fact of different
+types.  This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
+preserve byte-code compatibility with v19.  This kludge is known as the
+\"char-int confoundance disease\" and appears in a number of other
+functions with `old-foo' equivalents.
+
+Do not use this function!
+*/
+       (object1, object2))
+{
+  /* #### blasphemy */
+  return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil;
+}
+
+#endif
+
 
 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
 					   Lisp_Object start,
@@ -11798,25 +11819,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 +11866,20 @@
   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);
+  DEFSUBR (Fold_eq);
+#endif
 
   DEFSUBR (FassocX);
   DEFSUBR (FrassocX);