summaryrefslogtreecommitdiff
path: root/libguile/error.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-08-10 13:37:11 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-08-10 13:37:11 +0000
commit24d1f17168dde1fa6a10ff5e8a7b2fbf5d62187e (patch)
tree71acbc41de681618a6949caa588162ed629c7316 /libguile/error.c
parent18f9d34373e4ebf33b49b8144d48b40ce6f6c769 (diff)
downloadguile-24d1f17168dde1fa6a10ff5e8a7b2fbf5d62187e.tar.gz
(scm_error_scm): Throw directly instead of calling
scm_error, this avoids the back and forth conversion of SUBR and MESSAGE and also plugs a memory leak. (scm_error): Call scm_error_scm.
Diffstat (limited to 'libguile/error.c')
-rw-r--r--libguile/error.c68
1 files changed, 16 insertions, 52 deletions
diff --git a/libguile/error.c b/libguile/error.c
index f53b9ab4a..e61004a7a 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -52,35 +52,18 @@
*/
-/* All errors should pass through here. */
+/* Scheme interface to scm_error_scm. */
void
scm_error (SCM key, const char *subr, const char *message, SCM args, SCM rest)
{
- SCM arg_list;
- if (scm_gc_running_p)
- {
- /* The error occured during GC --- abort */
- fprintf (stderr, "Error in %s during GC: %s\n",
- subr ? subr : "unknown function",
- message ? message : "<empty message>");
- abort ();
- }
- arg_list = scm_list_4 (subr ? scm_makfrom0str (subr) : SCM_BOOL_F,
- message ? scm_makfrom0str (message) : SCM_BOOL_F,
- args,
- rest);
- scm_ithrow (key, arg_list, 1);
-
- /* No return, but just in case: */
- {
- const char msg[] = "guile:scm_error:scm_ithrow returned!\n";
-
- write (2, msg, (sizeof msg) - 1);
- }
- exit (1);
+ scm_error_scm
+ (key,
+ (subr == NULL) ? SCM_BOOL_F : scm_from_locale_string (subr),
+ (message == NULL) ? SCM_BOOL_F : scm_from_locale_string (message),
+ args, rest);
}
-/* Scheme interface to scm_error. */
+/* All errors should pass through here. */
SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
(SCM key, SCM subr, SCM message, SCM args, SCM data),
"Raise an error with key @var{key}. @var{subr} can be a string\n"
@@ -98,37 +81,18 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
"it will usually be @code{#f}.")
#define FUNC_NAME s_scm_error_scm
{
- char *szSubr;
- char *szMessage;
-
- SCM_VALIDATE_SYMBOL (1, key);
-
- if (scm_is_false (subr))
- {
- szSubr = NULL;
- }
- else if (SCM_SYMBOLP (subr))
- {
- szSubr = SCM_SYMBOL_CHARS (subr);
- }
- else
- {
- SCM_VALIDATE_STRING (2, subr);
- szSubr = SCM_STRING_CHARS (subr);
- }
-
- if (scm_is_false (message))
- {
- szMessage = NULL;
- }
- else
+ if (scm_gc_running_p)
{
- SCM_VALIDATE_STRING (2, message);
- szMessage = SCM_STRING_CHARS (message);
+ /* The error occured during GC --- abort */
+ fprintf (stderr, "Guile: error during GC.\n"),
+ abort ();
}
- scm_error (key, szSubr, szMessage, args, data);
- /* not reached. */
+ scm_ithrow (key, scm_list_4 (subr, message, args, data), 1);
+
+ /* No return, but just in case: */
+ fprintf (stderr, "Guile scm_ithrow returned!\n");
+ exit (1);
}
#undef FUNC_NAME