| 1 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, |
| 2 | * 2007, 2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc. |
| 3 | * |
| 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. |
| 8 | * |
| 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. |
| 13 | * |
| 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 |
| 17 | * 02110-1301 USA |
| 18 | */ |
| 19 | |
| 20 | |
| 21 | \f |
| 22 | |
| 23 | #ifdef HAVE_CONFIG_H |
| 24 | # include <config.h> |
| 25 | #endif |
| 26 | |
| 27 | #include <fcntl.h> /* for mingw */ |
| 28 | #include <signal.h> |
| 29 | #include <stdio.h> |
| 30 | #include <errno.h> |
| 31 | |
| 32 | #ifdef HAVE_PROCESS_H |
| 33 | #include <process.h> /* for mingw */ |
| 34 | #endif |
| 35 | |
| 36 | #include <unistd.h> |
| 37 | |
| 38 | #ifdef HAVE_SYS_TIME_H |
| 39 | #include <sys/time.h> |
| 40 | #endif |
| 41 | |
| 42 | #include <full-write.h> |
| 43 | |
| 44 | #include "libguile/_scm.h" |
| 45 | |
| 46 | #include "libguile/async.h" |
| 47 | #include "libguile/eval.h" |
| 48 | #include "libguile/root.h" |
| 49 | #include "libguile/vectors.h" |
| 50 | #include "libguile/threads.h" |
| 51 | |
| 52 | #include "libguile/validate.h" |
| 53 | #include "libguile/scmsigs.h" |
| 54 | |
| 55 | |
| 56 | \f |
| 57 | |
| 58 | /* SIGRETTYPE is the type that signal handlers return. See <signal.h> */ |
| 59 | |
| 60 | #ifdef RETSIGTYPE |
| 61 | # define SIGRETTYPE RETSIGTYPE |
| 62 | #else |
| 63 | # ifdef STDC_HEADERS |
| 64 | # define SIGRETTYPE void |
| 65 | # else |
| 66 | # define SIGRETTYPE int |
| 67 | # endif |
| 68 | #endif |
| 69 | |
| 70 | \f |
| 71 | |
| 72 | /* take_signal is installed as the C signal handler whenever a Scheme |
| 73 | handler is set. When a signal arrives, take_signal will write a |
| 74 | byte into the 'signal pipe'. The 'signal delivery thread' will |
| 75 | read this pipe and queue the appropriate asyncs. |
| 76 | |
| 77 | When Guile is built without threads, the signal handler will |
| 78 | install the async directly. |
| 79 | */ |
| 80 | |
| 81 | |
| 82 | /* Scheme vectors with information about a signal. signal_handlers |
| 83 | contains the handler procedure or #f, signal_handler_asyncs |
| 84 | contains the thunk to be marked as an async when the signal arrives |
| 85 | (or the cell with the thunk in a singlethreaded Guile), and |
| 86 | signal_handler_threads points to the thread that a signal should be |
| 87 | delivered to. |
| 88 | */ |
| 89 | static SCM *signal_handlers; |
| 90 | static SCM signal_handler_asyncs; |
| 91 | static SCM signal_handler_threads; |
| 92 | |
| 93 | /* The signal delivery thread. */ |
| 94 | scm_i_thread *scm_i_signal_delivery_thread = NULL; |
| 95 | |
| 96 | /* The mutex held when launching the signal delivery thread. */ |
| 97 | static scm_i_pthread_mutex_t signal_delivery_thread_mutex = |
| 98 | SCM_I_PTHREAD_MUTEX_INITIALIZER; |
| 99 | |
| 100 | |
| 101 | /* saves the original C handlers, when a new handler is installed. |
| 102 | set to SIG_ERR if the original handler is installed. */ |
| 103 | #ifdef HAVE_SIGACTION |
| 104 | static struct sigaction orig_handlers[NSIG]; |
| 105 | #else |
| 106 | static SIGRETTYPE (*orig_handlers[NSIG])(int); |
| 107 | #endif |
| 108 | |
| 109 | static SCM |
| 110 | close_1 (SCM proc, SCM arg) |
| 111 | { |
| 112 | return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL, |
| 113 | scm_list_2 (proc, arg))); |
| 114 | } |
| 115 | |
| 116 | #if SCM_USE_PTHREAD_THREADS |
| 117 | /* On mingw there's no notion of inter-process signals, only a raise() |
| 118 | within the process itself which apparently invokes the registered handler |
| 119 | immediately. Not sure how well the following code will cope in this |
| 120 | case. It builds but it may not offer quite the same scheme-level |
| 121 | semantics as on a proper system. If you're relying on much in the way of |
| 122 | signal handling on mingw you probably lose anyway. */ |
| 123 | |
| 124 | static int signal_pipe[2]; |
| 125 | |
| 126 | static SIGRETTYPE |
| 127 | take_signal (int signum) |
| 128 | { |
| 129 | char sigbyte = signum; |
| 130 | full_write (signal_pipe[1], &sigbyte, 1); |
| 131 | |
| 132 | #ifndef HAVE_SIGACTION |
| 133 | signal (signum, take_signal); |
| 134 | #endif |
| 135 | } |
| 136 | |
| 137 | struct signal_pipe_data |
| 138 | { |
| 139 | char sigbyte; |
| 140 | ssize_t n; |
| 141 | int err; |
| 142 | }; |
| 143 | |
| 144 | static void* |
| 145 | read_signal_pipe_data (void * data) |
| 146 | { |
| 147 | struct signal_pipe_data *sdata = data; |
| 148 | |
| 149 | sdata->n = read (signal_pipe[0], &sdata->sigbyte, 1); |
| 150 | sdata->err = errno; |
| 151 | |
| 152 | return NULL; |
| 153 | } |
| 154 | |
| 155 | static SCM |
| 156 | signal_delivery_thread (void *data) |
| 157 | { |
| 158 | int sig; |
| 159 | #if HAVE_PTHREAD_SIGMASK /* not on mingw, see notes above */ |
| 160 | sigset_t all_sigs; |
| 161 | sigfillset (&all_sigs); |
| 162 | scm_i_pthread_sigmask (SIG_SETMASK, &all_sigs, NULL); |
| 163 | #endif |
| 164 | |
| 165 | while (1) |
| 166 | { |
| 167 | struct signal_pipe_data sigdata; |
| 168 | |
| 169 | scm_without_guile (read_signal_pipe_data, &sigdata); |
| 170 | |
| 171 | sig = sigdata.sigbyte; |
| 172 | if (sigdata.n == 1 && sig >= 0 && sig < NSIG) |
| 173 | { |
| 174 | SCM h, t; |
| 175 | |
| 176 | h = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig); |
| 177 | t = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig); |
| 178 | if (scm_is_true (h)) |
| 179 | scm_system_async_mark_for_thread (h, t); |
| 180 | } |
| 181 | else if (sigdata.n == 0) |
| 182 | break; /* the signal pipe was closed. */ |
| 183 | else if (sigdata.n < 0 && sigdata.err != EINTR) |
| 184 | perror ("error in signal delivery thread"); |
| 185 | } |
| 186 | |
| 187 | return SCM_UNSPECIFIED; /* not reached unless all other threads exited */ |
| 188 | } |
| 189 | |
| 190 | static void |
| 191 | start_signal_delivery_thread (void) |
| 192 | { |
| 193 | SCM signal_thread; |
| 194 | |
| 195 | scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex); |
| 196 | |
| 197 | if (pipe2 (signal_pipe, O_CLOEXEC) != 0) |
| 198 | scm_syserror (NULL); |
| 199 | signal_thread = scm_spawn_thread (signal_delivery_thread, NULL, |
| 200 | scm_handle_by_message, |
| 201 | "signal delivery thread"); |
| 202 | scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread); |
| 203 | |
| 204 | scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex); |
| 205 | } |
| 206 | |
| 207 | void |
| 208 | scm_i_ensure_signal_delivery_thread () |
| 209 | { |
| 210 | static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; |
| 211 | scm_i_pthread_once (&once, start_signal_delivery_thread); |
| 212 | } |
| 213 | |
| 214 | #else /* !SCM_USE_PTHREAD_THREADS */ |
| 215 | |
| 216 | static SIGRETTYPE |
| 217 | take_signal (int signum) |
| 218 | { |
| 219 | SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, signum); |
| 220 | scm_i_thread *t = SCM_I_CURRENT_THREAD; |
| 221 | |
| 222 | if (scm_is_false (SCM_CDR (cell))) |
| 223 | { |
| 224 | SCM_SETCDR (cell, t->active_asyncs); |
| 225 | t->active_asyncs = cell; |
| 226 | t->pending_asyncs = 1; |
| 227 | } |
| 228 | |
| 229 | #ifndef HAVE_SIGACTION |
| 230 | signal (signum, take_signal); |
| 231 | #endif |
| 232 | } |
| 233 | |
| 234 | void |
| 235 | scm_i_ensure_signal_delivery_thread () |
| 236 | { |
| 237 | return; |
| 238 | } |
| 239 | |
| 240 | #endif /* !SCM_USE_PTHREAD_THREADS */ |
| 241 | |
| 242 | static void |
| 243 | install_handler (int signum, SCM thread, SCM handler) |
| 244 | { |
| 245 | if (scm_is_false (handler)) |
| 246 | { |
| 247 | SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F); |
| 248 | SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, SCM_BOOL_F); |
| 249 | } |
| 250 | else |
| 251 | { |
| 252 | SCM async = close_1 (handler, scm_from_int (signum)); |
| 253 | #if !SCM_USE_PTHREAD_THREADS |
| 254 | async = scm_cons (async, SCM_BOOL_F); |
| 255 | #endif |
| 256 | SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler); |
| 257 | SCM_SIMPLE_VECTOR_SET (signal_handler_asyncs, signum, async); |
| 258 | } |
| 259 | |
| 260 | SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread); |
| 261 | } |
| 262 | |
| 263 | SCM |
| 264 | scm_sigaction (SCM signum, SCM handler, SCM flags) |
| 265 | { |
| 266 | return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED); |
| 267 | } |
| 268 | |
| 269 | /* user interface for installation of signal handlers. */ |
| 270 | SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, |
| 271 | (SCM signum, SCM handler, SCM flags, SCM thread), |
| 272 | "Install or report the signal handler for a specified signal.\n\n" |
| 273 | "@var{signum} is the signal number, which can be specified using the value\n" |
| 274 | "of variables such as @code{SIGINT}.\n\n" |
| 275 | "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n" |
| 276 | "CAR is the current\n" |
| 277 | "signal hander, which will be either an integer with the value @code{SIG_DFL}\n" |
| 278 | "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n" |
| 279 | "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n" |
| 280 | "signal. The CDR contains the current @code{sigaction} flags for the handler.\n\n" |
| 281 | "If @var{handler} is provided, it is installed as the new handler for\n" |
| 282 | "@var{signum}. @var{handler} can be a Scheme procedure taking one\n" |
| 283 | "argument, or the value of @code{SIG_DFL} (default action) or\n" |
| 284 | "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n" |
| 285 | "was installed before @code{sigaction} was first used. When\n" |
| 286 | "a scheme procedure has been specified, that procedure will run\n" |
| 287 | "in the given @var{thread}. When no thread has been given, the\n" |
| 288 | "thread that made this call to @code{sigaction} is used.\n" |
| 289 | "Flags can optionally be specified for the new handler.\n" |
| 290 | "The return value is a pair with information about the\n" |
| 291 | "old handler as described above.\n\n" |
| 292 | "This interface does not provide access to the \"signal blocking\"\n" |
| 293 | "facility. Maybe this is not needed, since the thread support may\n" |
| 294 | "provide solutions to the problem of consistent access to data\n" |
| 295 | "structures.") |
| 296 | #define FUNC_NAME s_scm_sigaction_for_thread |
| 297 | { |
| 298 | int csig; |
| 299 | #ifdef HAVE_SIGACTION |
| 300 | struct sigaction action; |
| 301 | struct sigaction old_action; |
| 302 | #else |
| 303 | SIGRETTYPE (* chandler) (int) = SIG_DFL; |
| 304 | SIGRETTYPE (* old_chandler) (int); |
| 305 | #endif |
| 306 | int query_only = 0; |
| 307 | int save_handler = 0; |
| 308 | |
| 309 | SCM old_handler; |
| 310 | |
| 311 | csig = scm_to_signed_integer (signum, 0, NSIG-1); |
| 312 | |
| 313 | #if defined(HAVE_SIGACTION) |
| 314 | action.sa_flags = 0; |
| 315 | if (!SCM_UNBNDP (flags)) |
| 316 | action.sa_flags |= scm_to_int (flags); |
| 317 | sigemptyset (&action.sa_mask); |
| 318 | #endif |
| 319 | |
| 320 | if (SCM_UNBNDP (thread)) |
| 321 | thread = scm_current_thread (); |
| 322 | else |
| 323 | { |
| 324 | SCM_VALIDATE_THREAD (4, thread); |
| 325 | if (scm_c_thread_exited_p (thread)) |
| 326 | SCM_MISC_ERROR ("thread has already exited", SCM_EOL); |
| 327 | } |
| 328 | |
| 329 | scm_i_ensure_signal_delivery_thread (); |
| 330 | |
| 331 | SCM_CRITICAL_SECTION_START; |
| 332 | old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig); |
| 333 | if (SCM_UNBNDP (handler)) |
| 334 | query_only = 1; |
| 335 | else if (scm_is_integer (handler)) |
| 336 | { |
| 337 | long handler_int = scm_to_long (handler); |
| 338 | |
| 339 | if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN) |
| 340 | { |
| 341 | #ifdef HAVE_SIGACTION |
| 342 | action.sa_handler = (SIGRETTYPE (*) (int)) handler_int; |
| 343 | #else |
| 344 | chandler = (SIGRETTYPE (*) (int)) handler_int; |
| 345 | #endif |
| 346 | install_handler (csig, SCM_BOOL_F, SCM_BOOL_F); |
| 347 | } |
| 348 | else |
| 349 | { |
| 350 | SCM_CRITICAL_SECTION_END; |
| 351 | SCM_OUT_OF_RANGE (2, handler); |
| 352 | } |
| 353 | } |
| 354 | else if (scm_is_false (handler)) |
| 355 | { |
| 356 | /* restore the default handler. */ |
| 357 | #ifdef HAVE_SIGACTION |
| 358 | if (orig_handlers[csig].sa_handler == SIG_ERR) |
| 359 | query_only = 1; |
| 360 | else |
| 361 | { |
| 362 | action = orig_handlers[csig]; |
| 363 | orig_handlers[csig].sa_handler = SIG_ERR; |
| 364 | install_handler (csig, SCM_BOOL_F, SCM_BOOL_F); |
| 365 | } |
| 366 | #else |
| 367 | if (orig_handlers[csig] == SIG_ERR) |
| 368 | query_only = 1; |
| 369 | else |
| 370 | { |
| 371 | chandler = orig_handlers[csig]; |
| 372 | orig_handlers[csig] = SIG_ERR; |
| 373 | install_handler (csig, SCM_BOOL_F, SCM_BOOL_F); |
| 374 | } |
| 375 | #endif |
| 376 | } |
| 377 | else |
| 378 | { |
| 379 | SCM_VALIDATE_PROC (2, handler); |
| 380 | #ifdef HAVE_SIGACTION |
| 381 | action.sa_handler = take_signal; |
| 382 | if (orig_handlers[csig].sa_handler == SIG_ERR) |
| 383 | save_handler = 1; |
| 384 | #else |
| 385 | chandler = take_signal; |
| 386 | if (orig_handlers[csig] == SIG_ERR) |
| 387 | save_handler = 1; |
| 388 | #endif |
| 389 | install_handler (csig, thread, handler); |
| 390 | } |
| 391 | |
| 392 | /* XXX - Silently ignore setting handlers for `program error signals' |
| 393 | because they can't currently be handled by Scheme code. |
| 394 | */ |
| 395 | |
| 396 | switch (csig) |
| 397 | { |
| 398 | /* This list of program error signals is from the GNU Libc |
| 399 | Reference Manual */ |
| 400 | case SIGFPE: |
| 401 | case SIGILL: |
| 402 | case SIGSEGV: |
| 403 | #ifdef SIGBUS |
| 404 | case SIGBUS: |
| 405 | #endif |
| 406 | case SIGABRT: |
| 407 | #if defined(SIGIOT) && (SIGIOT != SIGABRT) |
| 408 | case SIGIOT: |
| 409 | #endif |
| 410 | #ifdef SIGTRAP |
| 411 | case SIGTRAP: |
| 412 | #endif |
| 413 | #ifdef SIGEMT |
| 414 | case SIGEMT: |
| 415 | #endif |
| 416 | #ifdef SIGSYS |
| 417 | case SIGSYS: |
| 418 | #endif |
| 419 | query_only = 1; |
| 420 | } |
| 421 | |
| 422 | #ifdef HAVE_SIGACTION |
| 423 | if (query_only) |
| 424 | { |
| 425 | if (sigaction (csig, 0, &old_action) == -1) |
| 426 | SCM_SYSERROR; |
| 427 | } |
| 428 | else |
| 429 | { |
| 430 | if (sigaction (csig, &action , &old_action) == -1) |
| 431 | SCM_SYSERROR; |
| 432 | if (save_handler) |
| 433 | orig_handlers[csig] = old_action; |
| 434 | } |
| 435 | if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN) |
| 436 | old_handler = scm_from_long ((long) old_action.sa_handler); |
| 437 | SCM_CRITICAL_SECTION_END; |
| 438 | return scm_cons (old_handler, scm_from_int (old_action.sa_flags)); |
| 439 | #else |
| 440 | if (query_only) |
| 441 | { |
| 442 | if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR) |
| 443 | SCM_SYSERROR; |
| 444 | if (signal (csig, old_chandler) == SIG_ERR) |
| 445 | SCM_SYSERROR; |
| 446 | } |
| 447 | else |
| 448 | { |
| 449 | if ((old_chandler = signal (csig, chandler)) == SIG_ERR) |
| 450 | SCM_SYSERROR; |
| 451 | if (save_handler) |
| 452 | orig_handlers[csig] = old_chandler; |
| 453 | } |
| 454 | if (old_chandler == SIG_DFL || old_chandler == SIG_IGN) |
| 455 | old_handler = scm_from_long ((long) old_chandler); |
| 456 | SCM_CRITICAL_SECTION_END; |
| 457 | return scm_cons (old_handler, scm_from_int (0)); |
| 458 | #endif |
| 459 | } |
| 460 | #undef FUNC_NAME |
| 461 | |
| 462 | SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, |
| 463 | (void), |
| 464 | "Return all signal handlers to the values they had before any call to\n" |
| 465 | "@code{sigaction} was made. The return value is unspecified.") |
| 466 | #define FUNC_NAME s_scm_restore_signals |
| 467 | { |
| 468 | int i; |
| 469 | for (i = 0; i < NSIG; i++) |
| 470 | { |
| 471 | #ifdef HAVE_SIGACTION |
| 472 | if (orig_handlers[i].sa_handler != SIG_ERR) |
| 473 | { |
| 474 | if (sigaction (i, &orig_handlers[i], NULL) == -1) |
| 475 | SCM_SYSERROR; |
| 476 | orig_handlers[i].sa_handler = SIG_ERR; |
| 477 | SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); |
| 478 | } |
| 479 | #else |
| 480 | if (orig_handlers[i] != SIG_ERR) |
| 481 | { |
| 482 | if (signal (i, orig_handlers[i]) == SIG_ERR) |
| 483 | SCM_SYSERROR; |
| 484 | orig_handlers[i] = SIG_ERR; |
| 485 | SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); |
| 486 | } |
| 487 | #endif |
| 488 | } |
| 489 | return SCM_UNSPECIFIED; |
| 490 | } |
| 491 | #undef FUNC_NAME |
| 492 | |
| 493 | #if HAVE_DECL_ALARM |
| 494 | SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0, |
| 495 | (SCM i), |
| 496 | "Set a timer to raise a @code{SIGALRM} signal after the specified\n" |
| 497 | "number of seconds (an integer). It's advisable to install a signal\n" |
| 498 | "handler for\n" |
| 499 | "@code{SIGALRM} beforehand, since the default action is to terminate\n" |
| 500 | "the process.\n\n" |
| 501 | "The return value indicates the time remaining for the previous alarm,\n" |
| 502 | "if any. The new value replaces the previous alarm. If there was\n" |
| 503 | "no previous alarm, the return value is zero.") |
| 504 | #define FUNC_NAME s_scm_alarm |
| 505 | { |
| 506 | return scm_from_uint (alarm (scm_to_uint (i))); |
| 507 | } |
| 508 | #undef FUNC_NAME |
| 509 | #endif /* HAVE_ALARM */ |
| 510 | |
| 511 | #ifdef HAVE_SETITIMER |
| 512 | SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0, |
| 513 | (SCM which_timer, |
| 514 | SCM interval_seconds, SCM interval_microseconds, |
| 515 | SCM value_seconds, SCM value_microseconds), |
| 516 | "Set the timer specified by @var{which_timer} according to the given\n" |
| 517 | "@var{interval_seconds}, @var{interval_microseconds},\n" |
| 518 | "@var{value_seconds}, and @var{value_microseconds} values.\n" |
| 519 | "\n" |
| 520 | "Return information about the timer's previous setting." |
| 521 | "\n" |
| 522 | "Errors are handled as described in the guile info pages under ``POSIX\n" |
| 523 | "Interface Conventions''.\n" |
| 524 | "\n" |
| 525 | "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n" |
| 526 | "and @code{ITIMER_PROF}.\n" |
| 527 | "\n" |
| 528 | "The return value will be a list of two cons pairs representing the\n" |
| 529 | "current state of the given timer. The first pair is the seconds and\n" |
| 530 | "microseconds of the timer @code{it_interval}, and the second pair is\n" |
| 531 | "the seconds and microseconds of the timer @code{it_value}.") |
| 532 | #define FUNC_NAME s_scm_setitimer |
| 533 | { |
| 534 | int rv; |
| 535 | int c_which_timer; |
| 536 | struct itimerval new_timer; |
| 537 | struct itimerval old_timer; |
| 538 | |
| 539 | c_which_timer = SCM_NUM2INT(1, which_timer); |
| 540 | new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds); |
| 541 | new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds); |
| 542 | new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds); |
| 543 | new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds); |
| 544 | |
| 545 | SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer)); |
| 546 | |
| 547 | if(rv != 0) |
| 548 | SCM_SYSERROR; |
| 549 | |
| 550 | return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec), |
| 551 | scm_from_long (old_timer.it_interval.tv_usec)), |
| 552 | scm_cons (scm_from_long (old_timer.it_value.tv_sec), |
| 553 | scm_from_long (old_timer.it_value.tv_usec))); |
| 554 | } |
| 555 | #undef FUNC_NAME |
| 556 | #endif /* HAVE_SETITIMER */ |
| 557 | |
| 558 | #ifdef HAVE_GETITIMER |
| 559 | SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0, |
| 560 | (SCM which_timer), |
| 561 | "Return information about the timer specified by @var{which_timer}" |
| 562 | "\n" |
| 563 | "Errors are handled as described in the guile info pages under ``POSIX\n" |
| 564 | "Interface Conventions''.\n" |
| 565 | "\n" |
| 566 | "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n" |
| 567 | "and @code{ITIMER_PROF}.\n" |
| 568 | "\n" |
| 569 | "The return value will be a list of two cons pairs representing the\n" |
| 570 | "current state of the given timer. The first pair is the seconds and\n" |
| 571 | "microseconds of the timer @code{it_interval}, and the second pair is\n" |
| 572 | "the seconds and microseconds of the timer @code{it_value}.") |
| 573 | #define FUNC_NAME s_scm_getitimer |
| 574 | { |
| 575 | int rv; |
| 576 | int c_which_timer; |
| 577 | struct itimerval old_timer; |
| 578 | |
| 579 | c_which_timer = SCM_NUM2INT(1, which_timer); |
| 580 | |
| 581 | SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer)); |
| 582 | |
| 583 | if(rv != 0) |
| 584 | SCM_SYSERROR; |
| 585 | |
| 586 | return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec), |
| 587 | scm_from_long (old_timer.it_interval.tv_usec)), |
| 588 | scm_cons (scm_from_long (old_timer.it_value.tv_sec), |
| 589 | scm_from_long (old_timer.it_value.tv_usec))); |
| 590 | } |
| 591 | #undef FUNC_NAME |
| 592 | #endif /* HAVE_GETITIMER */ |
| 593 | |
| 594 | #ifdef HAVE_PAUSE |
| 595 | SCM_DEFINE (scm_pause, "pause", 0, 0, 0, |
| 596 | (), |
| 597 | "Pause the current process (thread?) until a signal arrives whose\n" |
| 598 | "action is to either terminate the current process or invoke a\n" |
| 599 | "handler procedure. The return value is unspecified.") |
| 600 | #define FUNC_NAME s_scm_pause |
| 601 | { |
| 602 | pause (); |
| 603 | return SCM_UNSPECIFIED; |
| 604 | } |
| 605 | #undef FUNC_NAME |
| 606 | #endif |
| 607 | |
| 608 | SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0, |
| 609 | (SCM i), |
| 610 | "Wait for the given number of seconds (an integer) or until a signal\n" |
| 611 | "arrives. The return value is zero if the time elapses or the number\n" |
| 612 | "of seconds remaining otherwise.\n" |
| 613 | "\n" |
| 614 | "See also @code{usleep}.") |
| 615 | #define FUNC_NAME s_scm_sleep |
| 616 | { |
| 617 | return scm_from_uint (scm_std_sleep (scm_to_uint (i))); |
| 618 | } |
| 619 | #undef FUNC_NAME |
| 620 | |
| 621 | SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0, |
| 622 | (SCM i), |
| 623 | "Wait the given period @var{usecs} microseconds (an integer).\n" |
| 624 | "If a signal arrives the wait stops and the return value is the\n" |
| 625 | "time remaining, in microseconds. If the period elapses with no\n" |
| 626 | "signal the return is zero.\n" |
| 627 | "\n" |
| 628 | "On most systems the process scheduler is not microsecond accurate and\n" |
| 629 | "the actual period slept by @code{usleep} may be rounded to a system\n" |
| 630 | "clock tick boundary. Traditionally such ticks were 10 milliseconds\n" |
| 631 | "apart, and that interval is often still used.\n" |
| 632 | "\n" |
| 633 | "See also @code{sleep}.") |
| 634 | #define FUNC_NAME s_scm_usleep |
| 635 | { |
| 636 | return scm_from_ulong (scm_std_usleep (scm_to_ulong (i))); |
| 637 | } |
| 638 | #undef FUNC_NAME |
| 639 | |
| 640 | SCM_DEFINE (scm_raise, "raise", 1, 0, 0, |
| 641 | (SCM sig), |
| 642 | "Sends a specified signal @var{sig} to the current process, where\n" |
| 643 | "@var{sig} is as described for the kill procedure.") |
| 644 | #define FUNC_NAME s_scm_raise |
| 645 | { |
| 646 | if (raise (scm_to_int (sig)) != 0) |
| 647 | SCM_SYSERROR; |
| 648 | return SCM_UNSPECIFIED; |
| 649 | } |
| 650 | #undef FUNC_NAME |
| 651 | |
| 652 | \f |
| 653 | |
| 654 | void |
| 655 | scm_i_close_signal_pipe() |
| 656 | { |
| 657 | /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery |
| 658 | thread is being launched. The thread that calls this function is |
| 659 | already holding the thread admin mutex, so if the delivery thread hasn't |
| 660 | been launched at this point, it never will be before shutdown. */ |
| 661 | scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex); |
| 662 | |
| 663 | #if SCM_USE_PTHREAD_THREADS |
| 664 | if (scm_i_signal_delivery_thread != NULL) |
| 665 | close (signal_pipe[1]); |
| 666 | #endif |
| 667 | |
| 668 | scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex); |
| 669 | } |
| 670 | |
| 671 | void |
| 672 | scm_init_scmsigs () |
| 673 | { |
| 674 | int i; |
| 675 | |
| 676 | signal_handlers = |
| 677 | SCM_VARIABLE_LOC (scm_c_define ("signal-handlers", |
| 678 | scm_c_make_vector (NSIG, SCM_BOOL_F))); |
| 679 | signal_handler_asyncs = scm_c_make_vector (NSIG, SCM_BOOL_F); |
| 680 | signal_handler_threads = scm_c_make_vector (NSIG, SCM_BOOL_F); |
| 681 | |
| 682 | for (i = 0; i < NSIG; i++) |
| 683 | { |
| 684 | #ifdef HAVE_SIGACTION |
| 685 | orig_handlers[i].sa_handler = SIG_ERR; |
| 686 | |
| 687 | #else |
| 688 | orig_handlers[i] = SIG_ERR; |
| 689 | #endif |
| 690 | } |
| 691 | |
| 692 | scm_c_define ("NSIG", scm_from_long (NSIG)); |
| 693 | scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN)); |
| 694 | scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL)); |
| 695 | #ifdef SA_NOCLDSTOP |
| 696 | scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP)); |
| 697 | #endif |
| 698 | #ifdef SA_RESTART |
| 699 | scm_c_define ("SA_RESTART", scm_from_long (SA_RESTART)); |
| 700 | #endif |
| 701 | |
| 702 | #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) |
| 703 | /* Stuff needed by setitimer and getitimer. */ |
| 704 | scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL)); |
| 705 | scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL)); |
| 706 | scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF)); |
| 707 | #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */ |
| 708 | |
| 709 | #include "libguile/scmsigs.x" |
| 710 | } |
| 711 | |
| 712 | |
| 713 | /* |
| 714 | Local Variables: |
| 715 | c-file-style: "gnu" |
| 716 | End: |
| 717 | */ |