\f
#include <stdio.h>
+
#include "_scm.h"
#include "pairs.h"
#include "genio.h"
#include "throw.h"
-#include "scm_validate.h"
+#include "validate.h"
#include "error.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
/* Scheme interface to scm_error. */
SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
(SCM key, SCM subr, SCM message, SCM args, SCM rest),
-"Raise an error with key @var{key}. @var{subr} can be a string naming
-the procedure associated with the error, or @code{#f}. @var{message}
-is the error message string, possibly containing @code{~S} and @code{~A}
-escapes. When an error is reported, these are replaced by formating the
-corresponding members of @var{args}: @code{~A} (was @code{%s}) formats using @code{display}
-and @code(~S) (was @code{%S}) formats using @code{write}. @var{data} is a
-list or @code{#f} depending on @var{key}: if @var{key} is
-@code{system-error} then it should be a list
-containing the Unix @code{errno} value; If @var{key} is @code{signal} then
-it should be a list containing the Unix signal number; otherwise it
-will usually be @code{#f}.")
+ "Raise an error with key @var{key}. @var{subr} can be a string naming\n"
+ "the procedure associated with the error, or @code{#f}. @var{message}\n"
+ "is the error message string, possibly containing @code{~S} and @code{~A}\n"
+ "escapes. When an error is reported, these are replaced by formating the\n"
+ "corresponding members of @var{args}: @code{~A} (was @code{%s}) formats using @code{display}\n"
+ "and @code(~S) (was @code{%S}) formats using @code{write}. @var{data} is a\n"
+ "list or @code{#f} depending on @var{key}: if @var{key} is\n"
+ "@code{system-error} then it should be a list\n"
+ "containing the Unix @code{errno} value; If @var{key} is @code{signal} then\n"
+ "it should be a list containing the Unix signal number; otherwise it\n"
+ "will usually be @code{#f}.")
#define FUNC_NAME s_scm_error_scm
{
char *szSubr;
SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
(SCM err),
-"Returns the Unix error message corresponding to @var{errno}, an integer.")
+ "Returns the Unix error message corresponding to @var{errno}, an integer.")
#define FUNC_NAME s_scm_strerror
{
SCM_VALIDATE_INUM (1,err);
scm_error (scm_out_of_range_key,
subr,
"Argument out of range: ~S",
- scm_cons (bad_value, SCM_EOL),
+ SCM_LIST1(bad_value),
SCM_BOOL_F);
}
scm_error (scm_out_of_range_key,
subr,
"Argument ~S out of range: ~S",
- scm_listify (pos, bad_value, SCM_UNDEFINED),
+ SCM_LIST2(pos,bad_value),
SCM_BOOL_F);
}
scm_error (scm_args_number_key,
NULL,
"Wrong number of arguments to ~A",
- scm_cons (proc, SCM_EOL),
+ SCM_LIST1(proc),
SCM_BOOL_F);
}
subr,
(pos == 0) ? "Wrong type argument: ~S"
: "Wrong type argument in position ~A: ~S",
- (pos == 0) ? scm_cons (bad_value, SCM_EOL)
- : scm_cons (SCM_MAKINUM (pos), scm_cons (bad_value, SCM_EOL)),
+ (pos == 0) ? SCM_LIST1(bad_value)
+ : SCM_LIST2(SCM_MAKINUM(pos), bad_value),
SCM_BOOL_F);
}
+void
+scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *szMessage)
+{
+ SCM msg = scm_makfrom0str(szMessage);
+ if (pos == 0) {
+ scm_error (scm_arg_type_key,
+ subr, "Wrong type argument (expecting ~A): ~S",
+ SCM_LIST2(msg,bad_value),
+ SCM_BOOL_F);
+ } else {
+ scm_error (scm_arg_type_key,
+ subr,
+ "Wrong type argument in position ~A (expecting ~A): ~S",
+ SCM_LIST3(SCM_MAKINUM(pos),msg,bad_value),
+ SCM_BOOL_F);
+ }
+}
+
+
SCM_SYMBOL (scm_memory_alloc_key, "memory-allocation-error");
void
scm_memory_error (const char *subr)