diff options
-rw-r--r-- | libguile/ChangeLog | 13 | ||||
-rw-r--r-- | libguile/backtrace.c | 89 | ||||
-rw-r--r-- | libguile/print.c | 84 | ||||
-rw-r--r-- | libguile/print.h | 3 |
4 files changed, 140 insertions, 49 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f1e675d51..627e957f2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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. diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 4ec2895b0..f73c80dcc 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -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) diff --git a/libguile/print.c b/libguile/print.c index f0b8ec1d0..be50015a9 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -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 diff --git a/libguile/print.h b/libguile/print.h index 325c65c65..b4e8292c4 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -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); |