[COMMIT] New function OBJECT-ADDRESS

[Didier Verna]

NOTE: This patch has been committed.

  This patch adds a lisp function OBJECT-ADDRESS. See the docstring for
an explanation.


src/ChangeLog addition:

2011-06-01  Didier Verna  <didier at xemacs.org>

	* fns.c (Fobject_address): New function.
	* fns.c (syms_of_fns): DEFSUBR it.


XEmacs 21.5 source patch:
Diff command:   hg diff --git --show-function 
Files affected: src/fns.c

diff --git a/src/fns.c b/src/fns.c
--- a/src/fns.c
+++ b/src/fns.c
@@ -6213,6 +6213,36 @@ not allow their modification with `objec
 }
 
 
+DEFUN ("object-address", Fobject_address, 1, 1, 0, /*
+Return OBJECT's memory address as an integer.
+This may be useful for customized printing of unreadable Lisp objects.
+As this only makes sense for record type objects, this function returns nil
+for chars and integers.
+*/
+       (object))
+{
+  switch (XTYPE (object))
+    {
+    case Lisp_Type_Int_Even:
+    case Lisp_Type_Int_Odd:
+    case Lisp_Type_Char:
+      {
+	return Qnil;
+      }
+    case Lisp_Type_Record:
+      {
+	return make_integer ((EMACS_INT) GET_VOID_FROM_LISP (object));
+      }
+    default:
+      {
+	signal_error (Qinternal_error,
+		      "Internal error: illegal lisp object tag type",
+		      object);
+      }
+    }
+}
+
+
 
 static Lisp_Object
 tweaked_internal_equal (Lisp_Object obj1, Lisp_Object obj2,
@@ -11786,6 +11816,7 @@ syms_of_fns (void)
   DEFSUBR (Fremprop);
   DEFSUBR (Fobject_plist);
   DEFSUBR (Fobject_setplist);
+  DEFSUBR (Fobject_address);
   DEFSUBR (Fequal);
   DEFSUBR (Fequalp);
   DEFSUBR (Ffill);

-- 
Resistance is futile. You will be jazzimilated.

Scientific site:   http://www.lrde.epita.fr/~didier
Music (Jazz) site: http://www.didierverna.com