diff options
| author | Dmitry Antipov | 2012-12-26 19:40:19 +0400 |
|---|---|---|
| committer | Dmitry Antipov | 2012-12-26 19:40:19 +0400 |
| commit | 6cda572a0f7da777cea9680131aa79be3f9be999 (patch) | |
| tree | 4f0de8141497db44255e3ddb811615f1e7298542 /src | |
| parent | 8847a0de5bd2e0df62f85c53c4b8d57d942d49ba (diff) | |
| download | emacs-6cda572a0f7da777cea9680131aa79be3f9be999.tar.gz emacs-6cda572a0f7da777cea9680131aa79be3f9be999.zip | |
* print.c (print_object): If Lisp_Save_Value object's pointer
is the address of a memory area containing Lisp_Objects, try
to print them.
* alloc.c (valid_lisp_object_p): Adjust comment.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 4 | ||||
| -rw-r--r-- | src/alloc.c | 12 | ||||
| -rw-r--r-- | src/print.c | 42 |
3 files changed, 46 insertions, 12 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index d0e08317fba..d4794667ead 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -2,6 +2,10 @@ | |||
| 2 | 2 | ||
| 3 | * lisp.h (toplevel): Add two notices to the comment about | 3 | * lisp.h (toplevel): Add two notices to the comment about |
| 4 | defining a new Lisp data type. | 4 | defining a new Lisp data type. |
| 5 | * print.c (print_object): If Lisp_Save_Value object's pointer | ||
| 6 | is the address of a memory area containing Lisp_Objects, try | ||
| 7 | to print them. | ||
| 8 | * alloc.c (valid_lisp_object_p): Adjust comment. | ||
| 5 | 9 | ||
| 6 | 2012-12-26 Dmitry Antipov <dmantipov@yandex.ru> | 10 | 2012-12-26 Dmitry Antipov <dmantipov@yandex.ru> |
| 7 | 11 | ||
diff --git a/src/alloc.c b/src/alloc.c index 5a3ba465d81..f33c423ece7 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -4721,12 +4721,12 @@ valid_pointer_p (void *p) | |||
| 4721 | #endif | 4721 | #endif |
| 4722 | } | 4722 | } |
| 4723 | 4723 | ||
| 4724 | /* Return 2 if OBJ is a killed or special buffer object. | 4724 | /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a |
| 4725 | Return 1 if OBJ is a valid lisp object. | 4725 | valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we |
| 4726 | Return 0 if OBJ is NOT a valid lisp object. | 4726 | cannot validate OBJ. This function can be quite slow, so its primary |
| 4727 | Return -1 if we cannot validate OBJ. | 4727 | use is the manual debugging. The only exception is print_object, where |
| 4728 | This function can be quite slow, | 4728 | we use it to check whether the memory referenced by the pointer of |
| 4729 | so it should only be used in code for manual debugging. */ | 4729 | Lisp_Save_Value object contains valid objects. */ |
| 4730 | 4730 | ||
| 4731 | int | 4731 | int |
| 4732 | valid_lisp_object_p (Lisp_Object obj) | 4732 | valid_lisp_object_p (Lisp_Object obj) |
diff --git a/src/print.c b/src/print.c index bf86be5622e..b89d5685fba 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -2034,14 +2034,44 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 2034 | break; | 2034 | break; |
| 2035 | 2035 | ||
| 2036 | case Lisp_Misc_Save_Value: | 2036 | case Lisp_Misc_Save_Value: |
| 2037 | strout ("#<save_value ", -1, -1, printcharfun); | ||
| 2038 | { | 2037 | { |
| 2039 | int len = sprintf (buf, "ptr=%p int=%"pD"d", | 2038 | int i; |
| 2040 | XSAVE_VALUE (obj)->pointer, | 2039 | struct Lisp_Save_Value *v = XSAVE_VALUE (obj); |
| 2041 | XSAVE_VALUE (obj)->integer); | 2040 | |
| 2042 | strout (buf, len, len, printcharfun); | 2041 | strout ("#<save-value ", -1, -1, printcharfun); |
| 2042 | if (v->dogc) | ||
| 2043 | { | ||
| 2044 | int lim = min (v->integer, 8); | ||
| 2045 | |||
| 2046 | /* Try to print up to 8 objects we have saved. Although | ||
| 2047 | valid_lisp_object_p is slow, this shouldn't be a real | ||
| 2048 | bottleneck because such a saved values are quite rare. */ | ||
| 2049 | |||
| 2050 | i = sprintf (buf, "with %"pD"d objects", v->integer); | ||
| 2051 | strout (buf, i, i, printcharfun); | ||
| 2052 | |||
| 2053 | for (i = 0; i < lim; i++) | ||
| 2054 | { | ||
| 2055 | Lisp_Object maybe = ((Lisp_Object *) v->pointer)[i]; | ||
| 2056 | |||
| 2057 | if (valid_lisp_object_p (maybe)) | ||
| 2058 | { | ||
| 2059 | PRINTCHAR (' '); | ||
| 2060 | print_object (maybe, printcharfun, escapeflag); | ||
| 2061 | } | ||
| 2062 | else | ||
| 2063 | strout (" <invalid>", -1, -1, printcharfun); | ||
| 2064 | } | ||
| 2065 | if (i == lim && i < v->integer) | ||
| 2066 | strout (" ...", 4, 4, printcharfun); | ||
| 2067 | } | ||
| 2068 | else | ||
| 2069 | { | ||
| 2070 | i = sprintf (buf, "ptr=%p int=%"pD"d", v->pointer, v->integer); | ||
| 2071 | strout (buf, i, i, printcharfun); | ||
| 2072 | } | ||
| 2073 | PRINTCHAR ('>'); | ||
| 2043 | } | 2074 | } |
| 2044 | PRINTCHAR ('>'); | ||
| 2045 | break; | 2075 | break; |
| 2046 | 2076 | ||
| 2047 | default: | 2077 | default: |