mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Improve %string-dump and %symbol-dump
%string-dump and %symbol-dump are modified to return assocation lists
of string and symbol attributes instead of printing to stderr. They
are no longer conditional on SCM_DEBUG.
* libguile/strings.c (scm_sys_string_dump)
(scm_sys_symbol_dump): now returns alist of properties. No longer
require that SCM_DEBUG be defined.
(scm_sys_stringbuf_hist): now conditional on
SCM_STRING_LENGTH_HISTOGRAM
* libguile/strings.h: scm_sys_string_dump and scm_sys_symbol dump
are now declared as API
This commit is contained in:
Michael Gran
parent
50b1996f1b
commit
6ce6923b68
2 changed files with 182 additions and 58 deletions
|
|
@ -105,7 +105,7 @@
|
||||||
#define SET_STRINGBUF_SHARED(buf) \
|
#define SET_STRINGBUF_SHARED(buf) \
|
||||||
(SCM_SET_CELL_WORD_0 ((buf), SCM_CELL_WORD_0 (buf) | STRINGBUF_F_SHARED))
|
(SCM_SET_CELL_WORD_0 ((buf), SCM_CELL_WORD_0 (buf) | STRINGBUF_F_SHARED))
|
||||||
|
|
||||||
#if SCM_DEBUG
|
#if SCM_STRING_LENGTH_HISTOGRAM
|
||||||
static size_t lenhist[1001];
|
static size_t lenhist[1001];
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
@ -121,7 +121,7 @@ make_stringbuf (size_t len)
|
||||||
can be dropped.
|
can be dropped.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#if SCM_DEBUG
|
#if SCM_STRING_LENGTH_HISTOGRAM
|
||||||
if (len < 1000)
|
if (len < 1000)
|
||||||
lenhist[len]++;
|
lenhist[len]++;
|
||||||
else
|
else
|
||||||
|
|
@ -148,7 +148,7 @@ static SCM
|
||||||
make_wide_stringbuf (size_t len)
|
make_wide_stringbuf (size_t len)
|
||||||
{
|
{
|
||||||
scm_t_wchar *mem;
|
scm_t_wchar *mem;
|
||||||
#if SCM_DEBUG
|
#if SCM_STRING_LENGTH_HISTOGRAM
|
||||||
if (len < 1000)
|
if (len < 1000)
|
||||||
lenhist[len]++;
|
lenhist[len]++;
|
||||||
else
|
else
|
||||||
|
|
@ -780,80 +780,196 @@ scm_i_symbol_ref (SCM sym, size_t x)
|
||||||
/* Debugging
|
/* Debugging
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#if SCM_DEBUG
|
SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str),
|
||||||
|
"Returns an association list containing debugging information\n"
|
||||||
SCM scm_sys_string_dump (SCM);
|
"for @var{str}. The association list has the following entries."
|
||||||
SCM scm_sys_symbol_dump (SCM);
|
"@table @code\n"
|
||||||
SCM scm_sys_stringbuf_hist (void);
|
"@item string\n"
|
||||||
|
"The string itself.\n"
|
||||||
SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str), "")
|
"@item start\n"
|
||||||
|
"The start index of the string into its stringbuf\n"
|
||||||
|
"@item length\n"
|
||||||
|
"The length of the string\n"
|
||||||
|
"@item shared\n"
|
||||||
|
"If this string is a substring, it returns its parent string.\n"
|
||||||
|
"Otherwise, it returns @code{#f}\n"
|
||||||
|
"@item stringbuf\n"
|
||||||
|
"The string buffer that contains this string's characters\n"
|
||||||
|
"@item stringbuf-chars\n"
|
||||||
|
"A new string containing this string's stringbuf's characters\n"
|
||||||
|
"@item stringbuf-length\n"
|
||||||
|
"The number of characters in this stringbuf\n"
|
||||||
|
"@item stringbuf-shared\n"
|
||||||
|
"@code{#t} if this stringbuf is shared\n"
|
||||||
|
"@item stringbuf-inline\n"
|
||||||
|
"@code{#t} if this stringbuf's characters are stored in the\n"
|
||||||
|
"cell itself, or @code{#f} if they were allocated in memory\n"
|
||||||
|
"@item stringbuf-wide\n"
|
||||||
|
"@code{#t} if this stringbuf's characters are stored in a\n"
|
||||||
|
"32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
|
||||||
|
"buffer\n"
|
||||||
|
"@end table")
|
||||||
#define FUNC_NAME s_scm_sys_string_dump
|
#define FUNC_NAME s_scm_sys_string_dump
|
||||||
{
|
{
|
||||||
|
SCM e1, e2, e3, e4, e5, e6, e7, e8, e9, e10;
|
||||||
|
SCM buf;
|
||||||
SCM_VALIDATE_STRING (1, str);
|
SCM_VALIDATE_STRING (1, str);
|
||||||
fprintf (stderr, "%p:\n", str);
|
|
||||||
fprintf (stderr, " start: %u\n", STRING_START (str));
|
/* String info */
|
||||||
fprintf (stderr, " len: %u\n", STRING_LENGTH (str));
|
e1 = scm_cons (scm_from_locale_symbol ("string"),
|
||||||
if (scm_i_is_narrow_string (str))
|
str);
|
||||||
fprintf (stderr, " format: narrow\n");
|
e2 = scm_cons (scm_from_locale_symbol ("start"),
|
||||||
else
|
scm_from_size_t (STRING_START (str)));
|
||||||
fprintf (stderr, " format: wide\n");
|
e3 = scm_cons (scm_from_locale_symbol ("length"),
|
||||||
|
scm_from_size_t (STRING_LENGTH (str)));
|
||||||
|
|
||||||
if (IS_SH_STRING (str))
|
if (IS_SH_STRING (str))
|
||||||
{
|
{
|
||||||
fprintf (stderr, " string: %p\n", SH_STRING_STRING (str));
|
e4 = scm_cons (scm_from_locale_symbol ("shared"),
|
||||||
fprintf (stderr, "\n");
|
SH_STRING_STRING (str));
|
||||||
scm_sys_string_dump (SH_STRING_STRING (str));
|
buf = STRING_STRINGBUF (SH_STRING_STRING (str));
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM buf = STRING_STRINGBUF (str);
|
e4 = scm_cons (scm_from_locale_symbol ("shared"),
|
||||||
fprintf (stderr, " buf: %p\n", buf);
|
SCM_BOOL_F);
|
||||||
if (scm_i_is_narrow_string (str))
|
buf = STRING_STRINGBUF (str);
|
||||||
fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf));
|
|
||||||
else
|
|
||||||
fprintf (stderr, " chars: %p\n", STRINGBUF_WIDE_CHARS (buf));
|
|
||||||
fprintf (stderr, " length: %u\n", STRINGBUF_LENGTH (buf));
|
|
||||||
if (STRINGBUF_SHARED (buf))
|
|
||||||
fprintf (stderr, " shared: true\n");
|
|
||||||
else
|
|
||||||
fprintf (stderr, " shared: false\n");
|
|
||||||
if (STRINGBUF_INLINE (buf))
|
|
||||||
fprintf (stderr, " inline: true\n");
|
|
||||||
else
|
|
||||||
fprintf (stderr, " inline: false\n");
|
|
||||||
|
|
||||||
}
|
}
|
||||||
return SCM_UNSPECIFIED;
|
|
||||||
|
/* Stringbuf info */
|
||||||
|
e5 = scm_cons (scm_from_locale_symbol ("stringbuf"),
|
||||||
|
buf);
|
||||||
|
|
||||||
|
if (!STRINGBUF_WIDE (buf))
|
||||||
|
{
|
||||||
|
size_t len = STRINGBUF_LENGTH (buf);
|
||||||
|
char *cbuf;
|
||||||
|
SCM sbc = scm_i_make_string (len, &cbuf);
|
||||||
|
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
|
||||||
|
e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
|
||||||
|
sbc);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
size_t len = STRINGBUF_LENGTH (buf);
|
||||||
|
scm_t_wchar *cbuf;
|
||||||
|
SCM sbc = scm_i_make_wide_string (len, &cbuf);
|
||||||
|
u32_cpy ((scm_t_uint32 *) cbuf,
|
||||||
|
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
|
||||||
|
e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
|
||||||
|
sbc);
|
||||||
|
}
|
||||||
|
e7 = scm_cons (scm_from_locale_symbol ("stringbuf-length"),
|
||||||
|
scm_from_size_t (STRINGBUF_LENGTH (buf)));
|
||||||
|
if (STRINGBUF_SHARED (buf))
|
||||||
|
e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
|
||||||
|
SCM_BOOL_T);
|
||||||
|
else
|
||||||
|
e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
if (STRINGBUF_INLINE (buf))
|
||||||
|
e9 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"),
|
||||||
|
SCM_BOOL_T);
|
||||||
|
else
|
||||||
|
e9 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
if (STRINGBUF_WIDE (buf))
|
||||||
|
e10 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
|
||||||
|
SCM_BOOL_T);
|
||||||
|
else
|
||||||
|
e10 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
|
||||||
|
return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, e9, e10, SCM_UNDEFINED);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym), "")
|
SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym),
|
||||||
|
"Returns an association list containing debugging information\n"
|
||||||
|
"for @var{sym}. The association list has the following entries."
|
||||||
|
"@table @code\n"
|
||||||
|
"@item symbol\n"
|
||||||
|
"The symbol itself\n"
|
||||||
|
"@item hash\n"
|
||||||
|
"Its hash value\n"
|
||||||
|
"@item stringbuf\n"
|
||||||
|
"The string buffer that contains this symbol's characters\n"
|
||||||
|
"@item stringbuf-chars\n"
|
||||||
|
"A new string containing this symbols's stringbuf's characters\n"
|
||||||
|
"@item stringbuf-length\n"
|
||||||
|
"The number of characters in this stringbuf\n"
|
||||||
|
"@item stringbuf-shared\n"
|
||||||
|
"@code{#t} if this stringbuf is shared\n"
|
||||||
|
"@item stringbuf-inline\n"
|
||||||
|
"@code{#t} if this stringbuf's characters are stored in the\n"
|
||||||
|
"cell itself, or @code{#f} if they were allocated in memory\n"
|
||||||
|
"@item stringbuf-wide\n"
|
||||||
|
"@code{#t} if this stringbuf's characters are stored in a\n"
|
||||||
|
"32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
|
||||||
|
"buffer\n"
|
||||||
|
"@end table")
|
||||||
#define FUNC_NAME s_scm_sys_symbol_dump
|
#define FUNC_NAME s_scm_sys_symbol_dump
|
||||||
{
|
{
|
||||||
|
SCM e1, e2, e3, e4, e5, e6, e7, e8;
|
||||||
|
SCM buf;
|
||||||
SCM_VALIDATE_SYMBOL (1, sym);
|
SCM_VALIDATE_SYMBOL (1, sym);
|
||||||
fprintf (stderr, "%p:\n", sym);
|
e1 = scm_cons (scm_from_locale_symbol ("symbol"),
|
||||||
fprintf (stderr, " hash: %lu\n", scm_i_symbol_hash (sym));
|
sym);
|
||||||
if (scm_i_is_narrow_symbol (sym))
|
e2 = scm_cons (scm_from_locale_symbol ("hash"),
|
||||||
fprintf (stderr, " format: narrow\n");
|
scm_from_ulong (scm_i_symbol_hash (sym)));
|
||||||
|
|
||||||
|
buf = SYMBOL_STRINGBUF (sym);
|
||||||
|
|
||||||
|
/* Stringbuf info */
|
||||||
|
e3 = scm_cons (scm_from_locale_symbol ("stringbuf"),
|
||||||
|
buf);
|
||||||
|
|
||||||
|
if (!STRINGBUF_WIDE (buf))
|
||||||
|
{
|
||||||
|
size_t len = STRINGBUF_LENGTH (buf);
|
||||||
|
char *cbuf;
|
||||||
|
SCM sbc = scm_i_make_string (len, &cbuf);
|
||||||
|
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
|
||||||
|
e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
|
||||||
|
sbc);
|
||||||
|
}
|
||||||
else
|
else
|
||||||
fprintf (stderr, " format: wide\n");
|
{
|
||||||
{
|
size_t len = STRINGBUF_LENGTH (buf);
|
||||||
SCM buf = SYMBOL_STRINGBUF (sym);
|
scm_t_wchar *cbuf;
|
||||||
fprintf (stderr, " buf: %p\n", buf);
|
SCM sbc = scm_i_make_wide_string (len, &cbuf);
|
||||||
if (scm_i_is_narrow_symbol (sym))
|
u32_cpy ((scm_t_uint32 *) cbuf,
|
||||||
fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf));
|
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
|
||||||
else
|
e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
|
||||||
fprintf (stderr, " chars: %p\n", STRINGBUF_WIDE_CHARS (buf));
|
sbc);
|
||||||
fprintf (stderr, " length: %u\n", STRINGBUF_LENGTH (buf));
|
}
|
||||||
if (STRINGBUF_SHARED (buf))
|
e5 = scm_cons (scm_from_locale_symbol ("stringbuf-length"),
|
||||||
fprintf (stderr, " shared: true\n");
|
scm_from_size_t (STRINGBUF_LENGTH (buf)));
|
||||||
else
|
if (STRINGBUF_SHARED (buf))
|
||||||
fprintf (stderr, " shared: false\n");
|
e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
|
||||||
|
SCM_BOOL_T);
|
||||||
}
|
else
|
||||||
return SCM_UNSPECIFIED;
|
e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
if (STRINGBUF_INLINE (buf))
|
||||||
|
e7 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"),
|
||||||
|
SCM_BOOL_T);
|
||||||
|
else
|
||||||
|
e7 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
if (STRINGBUF_WIDE (buf))
|
||||||
|
e8 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
|
||||||
|
SCM_BOOL_T);
|
||||||
|
else
|
||||||
|
e8 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
|
||||||
|
SCM_BOOL_F);
|
||||||
|
return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, SCM_UNDEFINED);
|
||||||
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
#if SCM_STRING_LENGTH_HISTOGRAM
|
||||||
|
|
||||||
SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0, (void), "")
|
SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0, (void), "")
|
||||||
#define FUNC_NAME s_scm_sys_stringbuf_hist
|
#define FUNC_NAME s_scm_sys_stringbuf_hist
|
||||||
{
|
{
|
||||||
|
|
|
||||||
|
|
@ -179,6 +179,14 @@ SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
|
||||||
SCM end, size_t *cend);
|
SCM end, size_t *cend);
|
||||||
SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
|
SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
|
||||||
|
|
||||||
|
/* Debugging functions */
|
||||||
|
|
||||||
|
SCM_API SCM scm_sys_string_dump (SCM);
|
||||||
|
SCM_API SCM scm_sys_symbol_dump (SCM);
|
||||||
|
#if SCM_STRING_LENGTH_HISTOGRAM
|
||||||
|
SCM_API SCM scm_sys_stringbuf_hist (void);
|
||||||
|
#endif
|
||||||
|
|
||||||
/* deprecated stuff */
|
/* deprecated stuff */
|
||||||
|
|
||||||
#if SCM_ENABLE_DEPRECATED
|
#if SCM_ENABLE_DEPRECATED
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue