1 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2004, 2006, 2010,
2 * 2012 Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
31 #include "libguile/_scm.h"
32 #include "libguile/dynwind.h"
33 #include "libguile/pairs.h"
34 #include "libguile/strings.h"
35 #include "libguile/throw.h"
37 #include "libguile/validate.h"
38 #include "libguile/error.h"
53 /* {Errors and Exceptional Conditions}
57 /* Scheme interface to scm_error_scm. */
59 scm_error (SCM key
, const char *subr
, const char *message
, SCM args
, SCM rest
)
63 (subr
== NULL
) ? SCM_BOOL_F
: scm_from_locale_string (subr
),
64 (message
== NULL
) ? SCM_BOOL_F
: scm_from_locale_string (message
),
68 /* All errors should pass through here. */
69 SCM_DEFINE (scm_error_scm
, "scm-error", 5, 0, 0,
70 (SCM key
, SCM subr
, SCM message
, SCM args
, SCM data
),
71 "Raise an error with key @var{key}. @var{subr} can be a string\n"
72 "naming the procedure associated with the error, or @code{#f}.\n"
73 "@var{message} is the error message string, possibly containing\n"
74 "@code{~S} and @code{~A} escapes. When an error is reported,\n"
75 "these are replaced by formatting the corresponding members of\n"
76 "@var{args}: @code{~A} (was @code{%s} in older versions of\n"
77 "Guile) formats using @code{display} and @code{~S} (was\n"
78 "@code{%S}) formats using @code{write}. @var{data} is a list or\n"
79 "@code{#f} depending on @var{key}: if @var{key} is\n"
80 "@code{system-error} then it should be a list containing the\n"
81 "Unix @code{errno} value; If @var{key} is @code{signal} then it\n"
82 "should be a list containing the Unix signal number; If\n"
83 "@var{key} is @code{out-of-range} or @code{wrong-type-arg},\n"
84 "it is a list containing the bad value; otherwise\n"
85 "it will usually be @code{#f}.")
86 #define FUNC_NAME s_scm_error_scm
90 /* The error occured during GC --- abort */
91 fprintf (stderr
, "Guile: error during GC.\n"),
95 scm_ithrow (key
, scm_list_4 (subr
, message
, args
, data
), 1);
97 /* No return, but just in case: */
98 fprintf (stderr
, "Guile scm_ithrow returned!\n");
103 #if defined __MINGW32__ && defined HAVE_NETWORKING
104 # include "win32-socket.h"
105 # define SCM_I_STRERROR(err) \
106 ((err >= WSABASEERR) ? scm_i_socket_strerror (err) : strerror (err))
107 # define SCM_I_ERRNO() \
108 (errno ? errno : scm_i_socket_errno ())
110 # define SCM_I_STRERROR(err) strerror (err)
111 # define SCM_I_ERRNO() errno
112 #endif /* __MINGW32__ */
114 /* strerror may not be thread safe, for instance in glibc (version 2.3.2) an
115 error number not among the known values results in a string like "Unknown
116 error 9999" formed in a static buffer, which will be overwritten by a
117 similar call in another thread. A test program running two threads with
118 different unknown error numbers can trip this fairly quickly.
120 Some systems don't do what glibc does, instead just giving a single
121 "Unknown error" for unrecognised numbers. It doesn't seem worth trying
122 to tell if that's the case, a mutex is reasonably fast, and strerror
123 isn't needed very often.
125 strerror_r (when available) could be used, it might be a touch faster
126 than a frame and a mutex, though there's probably not much
129 SCM_DEFINE (scm_strerror
, "strerror", 1, 0, 0,
131 "Return the Unix error message corresponding to @var{err}, which\n"
132 "must be an integer value.")
133 #define FUNC_NAME s_scm_strerror
136 scm_dynwind_begin (0);
137 scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex
);
139 ret
= scm_from_locale_string (SCM_I_STRERROR (scm_to_int (err
)));
146 SCM_GLOBAL_SYMBOL (scm_system_error_key
, "system-error");
148 scm_syserror (const char *subr
)
150 SCM err
= scm_from_int (SCM_I_ERRNO ());
152 /* It could be that we're getting here because the syscall was
153 interrupted by a signal. In that case a signal handler might have
154 been queued to run. The signal handler probably throws an
157 If we don't try to run the signal handler now, it will run later,
158 which would result in two exceptions being thrown: this syserror,
159 and then at some later time the exception thrown by the async
162 The problem is that we don't know if handling the signal caused an
163 async to be queued. By this time scmsigs.c:take_signal will have
164 written a byte on the fd, but we don't know if the signal-handling
165 thread has read it off and queued an async.
167 Ideally we need some API like scm_i_ensure_signals_delivered() to
168 catch up signal delivery. Barring that, we just cross our digits
169 and pray; it could be that we handle the signal in time, and just
170 throw once, or it could be that we miss the deadline and throw
174 if (scm_to_int (err
) == EINTR
)
178 scm_error (scm_system_error_key
,
181 scm_cons (scm_strerror (err
), SCM_EOL
),
182 scm_cons (err
, SCM_EOL
));
186 scm_syserror_msg (const char *subr
, const char *message
, SCM args
, int eno
)
188 /* See above note about the EINTR signal handling race. */
193 scm_error (scm_system_error_key
,
197 scm_cons (scm_from_int (eno
), SCM_EOL
));
200 SCM_GLOBAL_SYMBOL (scm_num_overflow_key
, "numerical-overflow");
202 scm_num_overflow (const char *subr
)
204 scm_error (scm_num_overflow_key
,
206 "Numerical overflow",
211 SCM_GLOBAL_SYMBOL (scm_out_of_range_key
, "out-of-range");
213 scm_out_of_range (const char *subr
, SCM bad_value
)
215 scm_error (scm_out_of_range_key
,
217 "Value out of range: ~S",
218 scm_list_1 (bad_value
),
219 scm_list_1 (bad_value
));
223 scm_out_of_range_pos (const char *subr
, SCM bad_value
, SCM pos
)
225 scm_error (scm_out_of_range_key
,
227 "Argument ~A out of range: ~S",
228 scm_list_2 (pos
, bad_value
),
229 scm_list_1 (bad_value
));
233 SCM_GLOBAL_SYMBOL (scm_args_number_key
, "wrong-number-of-args");
235 scm_wrong_num_args (SCM proc
)
237 scm_error (scm_args_number_key
,
239 "Wrong number of arguments to ~A",
246 scm_error_num_args_subr (const char *subr
)
248 scm_error (scm_args_number_key
,
250 "Wrong number of arguments to ~A",
251 scm_list_1 (scm_from_locale_string (subr
)),
256 SCM_GLOBAL_SYMBOL (scm_arg_type_key
, "wrong-type-arg");
258 scm_wrong_type_arg (const char *subr
, int pos
, SCM bad_value
)
260 scm_error (scm_arg_type_key
,
262 (pos
== 0) ? "Wrong type: ~S"
263 : "Wrong type argument in position ~A: ~S",
264 (pos
== 0) ? scm_list_1 (bad_value
)
265 : scm_list_2 (scm_from_int (pos
), bad_value
),
266 scm_list_1 (bad_value
));
270 scm_i_wrong_type_arg_symbol (SCM symbol
, int pos
, SCM bad_value
)
272 scm_error_scm (scm_arg_type_key
,
273 scm_symbol_to_string (symbol
),
274 (pos
== 0) ? scm_from_locale_string ("Wrong type: ~S")
275 : scm_from_locale_string ("Wrong type argument in position ~A: ~S"),
276 (pos
== 0) ? scm_list_1 (bad_value
)
277 : scm_list_2 (scm_from_int (pos
), bad_value
),
278 scm_list_1 (bad_value
));
279 scm_remember_upto_here_2 (symbol
, bad_value
);
283 scm_wrong_type_arg_msg (const char *subr
, int pos
, SCM bad_value
, const char *szMessage
)
285 SCM msg
= scm_from_locale_string (szMessage
);
288 scm_error (scm_arg_type_key
,
289 subr
, "Wrong type (expecting ~A): ~S",
290 scm_list_2 (msg
, bad_value
),
291 scm_list_1 (bad_value
));
295 scm_error (scm_arg_type_key
,
297 "Wrong type argument in position ~A (expecting ~A): ~S",
298 scm_list_3 (scm_from_int (pos
), msg
, bad_value
),
299 scm_list_1 (bad_value
));
304 SCM_GLOBAL_SYMBOL (scm_memory_alloc_key
, "memory-allocation-error");
306 scm_memory_error (const char *subr
)
308 fprintf (stderr
, "FATAL: memory error in %s\n", subr
);
312 SCM_GLOBAL_SYMBOL (scm_misc_error_key
, "misc-error");
314 scm_misc_error (const char *subr
, const char *message
, SCM args
)
316 scm_error (scm_misc_error_key
, subr
, message
, args
, SCM_BOOL_F
);
322 #include "libguile/cpp-E.c"
323 #include "libguile/error.x"