mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

* backtrace.c (scm_display_error_message): Introduced fancy

Browse source 
printing with max level 7 and length 10.  (Purpose: avoid printing
gigantic objects in error messages.)

* print.c, print.h (scm_i_port_with_print_state): New function.

* print.c (scm_iprin1, scm_printer_apply,
scm_port_with_print_state): Use scm_i_port_with_print_state.
(scm_simple_format): Modified not to destroy print states.
(print_state_mutex): New mutex.
(scm_make_print_state, scm_free_print_state, scm_prin1):
Lock/unlock print_state_mutex.
This commit is contained in:
Mikael Djurfeldt 2003-05-12 20:46:52 +00:00
parent 7aaf8dc9f7
commit dfd03fb91b
4 changed files with 140 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/ChangeLog
View file

@ -1,5 +1,18 @@
2003-05-12 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* backtrace.c (scm_display_error_message): Introduced fancy
printing with max level 7 and length 10. (Purpose: avoid printing
gigantic objects in error messages.)
* print.c, print.h (scm_i_port_with_print_state): New function.
* print.c (scm_iprin1, scm_printer_apply,
scm_port_with_print_state): Use scm_i_port_with_print_state.
(scm_simple_format): Modified not to destroy print states.
(print_state_mutex): New mutex.
(scm_make_print_state, scm_free_print_state, scm_prin1):
Lock/unlock print_state_mutex.
* deprecated.h (SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK):
Use current names in definitions.

89
libguile/backtrace.c
View file

@ -1,5 +1,5 @@
/* Printing of backtraces and error messages
* Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation
* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -40,6 +40,7 @@
#include "libguile/fluids.h"
#include "libguile/ports.h"
#include "libguile/strings.h"
#include "libguile/dynwind.h"
#include "libguile/validate.h"
#include "libguile/lang.h"
@ -47,11 +48,22 @@
#include "libguile/filesys.h"
/* {Error reporting and backtraces}
* (A first approximation.)
*
* Note that these functions shouldn't generate errors themselves.
*/
/* Print parameters for error messages. */
#define DISPLAY_ERROR_MESSAGE_MAX_LEVEL 7
#define DISPLAY_ERROR_MESSAGE_MAX_LENGTH 10
/* Print parameters for failing expressions in error messages.
* (See also `print_params' below for backtrace print parameters.)
*/
#define DISPLAY_EXPRESSION_MAX_LEVEL 2
#define DISPLAY_EXPRESSION_MAX_LENGTH 3
#undef SCM_ASSERT
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
if (!(_cond)) \
@ -91,19 +103,68 @@ display_header (SCM source, SCM port)
}
struct display_error_message_data {
SCM message;
SCM args;
SCM port;
scm_print_state *pstate;
int old_fancyp;
int old_level;
int old_length;
};
static SCM
display_error_message (struct display_error_message_data *d)
{
if (SCM_STRINGP (d->message) && !SCM_FALSEP (scm_list_p (d->args)))
scm_simple_format (d->port, d->message, d->args);
else
scm_display (d->message, d->port);
scm_newline (d->port);
return SCM_UNSPECIFIED;
}
static void
before_display_error_message (struct display_error_message_data *d)
{
scm_print_state *pstate = d->pstate;
d->old_fancyp = pstate->fancyp;
d->old_level = pstate->level;
d->old_length = pstate->length;
pstate->fancyp = 1;
pstate->level = DISPLAY_ERROR_MESSAGE_MAX_LEVEL;
pstate->length = DISPLAY_ERROR_MESSAGE_MAX_LENGTH;
}
static void
after_display_error_message (struct display_error_message_data *d)
{
scm_print_state *pstate = d->pstate;
pstate->fancyp = d->old_fancyp;
pstate->level = d->old_level;
pstate->length = d->old_length;
}
void
scm_display_error_message (SCM message, SCM args, SCM port)
{
if (SCM_STRINGP (message) && !SCM_FALSEP (scm_list_p (args)))
{
scm_simple_format (port, message, args);
scm_newline (port);
}
else
{
scm_display (message, port);
scm_newline (port);
}
struct display_error_message_data d;
SCM print_state;
scm_print_state *pstate;
port = scm_i_port_with_print_state (port, SCM_UNDEFINED);
print_state = SCM_PORT_WITH_PS_PS (port);
pstate = SCM_PRINT_STATE (print_state);
d.message = message;
d.args = args;
d.port = port;
d.pstate = pstate;
scm_internal_dynamic_wind ((scm_t_guard) before_display_error_message,
(scm_t_inner) display_error_message,
(scm_t_guard) after_display_error_message,
&d,
&d);
}
static void
@ -113,8 +174,8 @@ display_expression (SCM frame, SCM pname, SCM source, SCM port)
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->writingp = 0;
pstate->fancyp = 1;
pstate->level = 2;
pstate->length = 3;
pstate->level = DISPLAY_EXPRESSION_MAX_LEVEL;
pstate->length = DISPLAY_EXPRESSION_MAX_LENGTH;
if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname))
{
if (SCM_FRAMEP (frame)

84
libguile/print.c
View file

@ -165,6 +165,7 @@ do { \
SCM scm_print_state_vtable = SCM_BOOL_F;
static SCM print_state_pool = SCM_EOL;
SCM_MUTEX (print_state_mutex);
#ifdef GUILE_DEBUG /* Used for debugging purposes */
@ -204,13 +205,13 @@ scm_make_print_state ()
SCM answer = SCM_BOOL_F;
/* First try to allocate a print state from the pool */
SCM_DEFER_INTS;
scm_i_plugin_mutex_lock (&print_state_mutex);
if (!SCM_NULLP (print_state_pool))
{
answer = SCM_CAR (print_state_pool);
print_state_pool = SCM_CDR (print_state_pool);
}
SCM_ALLOW_INTS;
scm_i_plugin_mutex_unlock (&print_state_mutex);
return SCM_FALSEP (answer) ? make_print_state () : answer;
}
@ -227,10 +228,27 @@ scm_free_print_state (SCM print_state)
*/
pstate->fancyp = 0;
pstate->revealed = 0;
SCM_DEFER_INTS;
scm_i_plugin_mutex_lock (&print_state_mutex);
handle = scm_cons (print_state, print_state_pool);
print_state_pool = handle;
SCM_ALLOW_INTS;
scm_i_plugin_mutex_unlock (&print_state_mutex);
}
SCM
scm_i_port_with_print_state (SCM port, SCM print_state)
{
if (SCM_UNBNDP (print_state))
{
if (SCM_PORT_WITH_PS_P (port))
return port;
else
print_state = scm_make_print_state ();
/* port does not need to be coerced since it doesn't have ps */
}
else
port = SCM_COERCE_OUTPORT (port);
SCM_RETURN_NEWSMOB (scm_tc16_port_with_ps,
SCM_UNPACK (scm_cons (port, print_state)));
}
static void
@ -434,9 +452,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
SCM pwps, print = pstate->writingp ? g_write : g_display;
if (!print)
goto print_struct;
SCM_NEWSMOB (pwps,
scm_tc16_port_with_ps,
SCM_UNPACK (scm_cons (port, pstate->handle)));
pwps = scm_i_port_with_print_state (port, pstate->handle);
pstate->revealed = 1;
scm_call_generic_2 (print, exp, pwps);
}
@ -670,13 +686,13 @@ scm_prin1 (SCM exp, SCM port, int writingp)
else
{
/* First try to allocate a print state from the pool */
SCM_DEFER_INTS;
scm_i_plugin_mutex_lock (&print_state_mutex);
if (!SCM_NULLP (print_state_pool))
{
handle = print_state_pool;
print_state_pool = SCM_CDR (print_state_pool);
}
SCM_ALLOW_INTS;
scm_i_plugin_mutex_unlock (&print_state_mutex);
if (SCM_FALSEP (handle))
handle = scm_list_1 (make_print_state ());
pstate_scm = SCM_CAR (handle);
@ -693,10 +709,10 @@ scm_prin1 (SCM exp, SCM port, int writingp)
if (!SCM_FALSEP (handle) && !pstate->revealed)
{
SCM_DEFER_INTS;
scm_i_plugin_mutex_lock (&print_state_mutex);
SCM_SETCDR (handle, print_state_pool);
print_state_pool = handle;
SCM_ALLOW_INTS;
scm_i_plugin_mutex_unlock (&print_state_mutex);
}
}
@ -900,7 +916,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
"containing the formatted text. Does not add a trailing newline.")
#define FUNC_NAME s_scm_simple_format
{
SCM answer = SCM_UNSPECIFIED;
SCM port, answer = SCM_UNSPECIFIED;
int fReturnString = 0;
int writingp;
char *start;
@ -909,20 +925,21 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
if (SCM_EQ_P (destination, SCM_BOOL_T))
{
destination = scm_cur_outp;
destination = port = scm_cur_outp;
}
else if (SCM_FALSEP (destination))
{
fReturnString = 1;
destination = scm_mkstrport (SCM_INUM0,
scm_make_string (SCM_INUM0, SCM_UNDEFINED),
SCM_OPN | SCM_WRTNG,
FUNC_NAME);
port = scm_mkstrport (SCM_INUM0,
scm_make_string (SCM_INUM0, SCM_UNDEFINED),
SCM_OPN | SCM_WRTNG,
FUNC_NAME);
destination = port;
}
else
{
SCM_VALIDATE_OPORT_VALUE (1, destination);
destination = SCM_COERCE_OUTPORT (destination);
port = SCM_COERCE_OUTPORT (destination);
}
SCM_VALIDATE_STRING (2, message);
SCM_VALIDATE_REST_ARGUMENT (args);
@ -944,12 +961,12 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
writingp = 1;
break;
case '~':
scm_lfwrite (start, p - start, destination);
scm_lfwrite (start, p - start, port);
start = p + 1;
continue;
case '%':
scm_lfwrite (start, p - start - 1, destination);
scm_newline (destination);
scm_lfwrite (start, p - start - 1, port);
scm_newline (port);
start = p + 1;
continue;
default:
@ -963,13 +980,14 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
scm_list_1 (SCM_MAKE_CHAR (*p)));
scm_lfwrite (start, p - start - 1, destination);
scm_lfwrite (start, p - start - 1, port);
/* we pass destination here */
scm_prin1 (SCM_CAR (args), destination, writingp);
args = SCM_CDR (args);
start = p + 1;
}
scm_lfwrite (start, p - start, destination);
scm_lfwrite (start, p - start, port);
if (!SCM_EQ_P (args, SCM_EOL))
SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",
scm_list_1 (scm_length (args)));
@ -1044,25 +1062,23 @@ port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate)
SCM
scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)
{
SCM pwps;
SCM pair = scm_cons (port, pstate->handle);
SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (pair));
pstate->revealed = 1;
return scm_call_2 (proc, exp, pwps);
return scm_call_2 (proc, exp,
scm_i_port_with_print_state (port, pstate->handle));
}
SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,
SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 1, 1, 0,
(SCM port, SCM pstate),
"Create a new port which behaves like @var{port}, but with an\n"
"included print state @var{pstate}.")
"included print state @var{pstate}. @var{pstate} is optional.\n"
"If @var{pstate} isn't supplied and @var{port} already has\n"
"a print state, the old print state is reused.")
#define FUNC_NAME s_scm_port_with_print_state
{
SCM pwps;
SCM_VALIDATE_OPORT_VALUE (1, port);
SCM_VALIDATE_PRINTSTATE (2, pstate);
port = SCM_COERCE_OUTPORT (port);
SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate)));
return pwps;
if (!SCM_UNBNDP (pstate))
SCM_VALIDATE_PRINTSTATE (2, pstate);
return scm_i_port_with_print_state (port, pstate);
}
#undef FUNC_NAME

3
libguile/print.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PRINT_H
#define SCM_PRINT_H
/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001, 2003 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -79,6 +79,7 @@ SCM_API scm_t_bits scm_tc16_port_with_ps;
SCM_API SCM scm_print_options (SCM setting);
SCM_API SCM scm_make_print_state (void);
SCM_API void scm_free_print_state (SCM print_state);
SCM scm_i_port_with_print_state (SCM port, SCM print_state);
SCM_API void scm_intprint (long n, int radix, SCM port);
SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
SCM_API void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate);