Mercurial > hg > xemacs-beta
changeset 5516:fa5fc2e3d9a6
New function OBJECT-ADDRESS.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2011-06-01 Didier Verna <didier@xemacs.org>
* fns.c (Fobject_address): New function.
* fns.c (syms_of_fns): DEFSUBR it.
| author | Didier Verna <didier@xemacs.org> |
|---|---|
| date | Wed, 01 Jun 2011 10:53:50 +0200 |
| parents | f87be7ddd60d |
| children | 5e128eda1d1f |
| files | src/ChangeLog src/fns.c |
| diffstat | 2 files changed, 36 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Sun May 29 20:56:07 2011 +0200 +++ b/src/ChangeLog Wed Jun 01 10:53:50 2011 +0200 @@ -1,3 +1,8 @@ +2011-06-01 Didier Verna <didier@xemacs.org> + + * fns.c (Fobject_address): New function. + * fns.c (syms_of_fns): DEFSUBR it. + 2011-05-29 Didier Verna <didier@xemacs.org> * console-impl.h (struct console_methods): Remove device parameter
--- a/src/fns.c Sun May 29 20:56:07 2011 +0200 +++ b/src/fns.c Wed Jun 01 10:53:50 2011 +0200 @@ -6213,6 +6213,36 @@ } +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 @@ DEFSUBR (Fremprop); DEFSUBR (Fobject_plist); DEFSUBR (Fobject_setplist); + DEFSUBR (Fobject_address); DEFSUBR (Fequal); DEFSUBR (Fequalp); DEFSUBR (Ffill);