libguile/scmsigs.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16  */
  17
  18
  19 \f
  20
  21 #if HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <signal.h>
  26 #include <errno.h>
  27
  28 #include "libguile/_scm.h"
  29
  30 #include "libguile/async.h"
  31 #include "libguile/eval.h"
  32 #include "libguile/root.h"
  33 #include "libguile/vectors.h"
  34
  35 #include "libguile/validate.h"
  36 #include "libguile/scmsigs.h"
  37
  38 #ifdef HAVE_UNISTD_H
  39 #include <unistd.h>
  40 #endif
  41
  42 #ifdef HAVE_SYS_TIME_H
  43 #include <sys/time.h>
  44 #endif
  45
  46 #ifdef __MINGW32__
  47 #include <windows.h>
  48 #define alarm(sec) (0)
  49 /* This weird comma expression is because Sleep is void under Windows. */
  50 #define sleep(sec) (Sleep ((sec) * 1000), 0)
  51 #define usleep(usec) (Sleep ((usec) / 1000), 0)
  52 #define kill(pid, sig) raise (sig)
  53 #endif
  54
  55 \f
  56
  57 /* SIGRETTYPE is the type that signal handlers return.  See <signal.h> */
  58
  59 #ifdef RETSIGTYPE
  60 # define SIGRETTYPE RETSIGTYPE
  61 #else
  62 # ifdef STDC_HEADERS
  63 #  define SIGRETTYPE void
  64 # else
  65 #  define SIGRETTYPE int
  66 # endif
  67 #endif
  68
  69 \f
  70
  71 /* take_signal is installed as the C signal handler whenever a Scheme
  72    handler is set.  when a signal arrives, take_signal will queue the
  73    Scheme handler procedure for its thread.  */
  74
  75
  76 /* Scheme vectors with information about a signal.  signal_handlers
  77    contains the handler procedure or #f, signal_handler_cells contains
  78    pre-queued cells for the handler (since we can't do fancy things
  79    during signal delivery), signal_cell_handlers contains the SCM
  80    value to be stuffed into the pre-queued cell upon delivery, and
  81    signal_handler_threads points to the thread that a signal should be
  82    delivered to.
  83 */
  84 static SCM *signal_handlers;
  85 static SCM signal_handler_cells;
  86 static SCM signal_cell_handlers;
  87 static SCM signal_handler_threads;
  88
  89 /* saves the original C handlers, when a new handler is installed.
  90    set to SIG_ERR if the original handler is installed.  */
  91 #ifdef HAVE_SIGACTION
  92 static struct sigaction orig_handlers[NSIG];
  93 #else
  94 static SIGRETTYPE (*orig_handlers[NSIG])(int);
  95 #endif
  96
  97
  98 static SIGRETTYPE
  99 take_signal (int signum)
 100 {
 101   if (signum >= 0 && signum < NSIG)
 102     {
 103       SCM cell = SCM_VECTOR_REF(signal_handler_cells, signum);
 104       SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
 105       SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
 106       scm_root_state *root = scm_i_thread_root (thread);
 107       if (SCM_CONSP (cell))
 108         {
 109           SCM_SETCAR (cell, handler);
 110           root->pending_asyncs = 1;
 111         }
 112     }
 113
 114 #ifndef HAVE_SIGACTION
 115   signal (signum, take_signal);
 116 #endif
 117 }
 118
 119 SCM
 120 scm_sigaction (SCM signum, SCM handler, SCM flags)
 121 {
 122   return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED);
 123 }
 124
 125 static SCM
 126 close_1 (SCM proc, SCM arg)
 127 {
 128   return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL,
 129                                            scm_list_2 (proc, arg)));
 130 }
 131
 132 /* Make sure that signal SIGNUM can be delivered to THREAD, using
 133    HANDLER.  THREAD and HANDLER must either both be non-#f (which
 134    means install the handler), or both #f (which means deinstall an
 135    existing handler).
 136 */
 137
 138 struct install_handler_data {
 139   int signum;
 140   SCM thread;
 141   SCM handler;
 142 };
 143
 144 static SCM
 145 scm_delq_spine_x (SCM cell, SCM list)
 146 {
 147   SCM s = list, prev = SCM_BOOL_F;
 148
 149   while (!scm_is_eq (cell, s))
 150     {
 151       if (SCM_NULLP (s))
 152         return list;
 153       prev = s;
 154       s = SCM_CDR (s);
 155     }
 156   if (scm_is_false (prev))
 157     return SCM_CDR (cell);
 158   else
 159     {
 160       SCM_SETCDR (prev, SCM_CDR (cell));
 161       return list;
 162     }
 163 }
 164
 165 static void *
 166 really_install_handler (void *data)
 167 {
 168   struct install_handler_data *args = data;
 169   int signum = args->signum;
 170   SCM thread = args->thread;
 171   SCM handler = args->handler;
 172   SCM cell;
 173   SCM old_thread;
 174
 175   /* The following modifications are done while signals can be
 176      delivered.  That is not a real problem since the signal handler
 177      will only touch the car of the handler cell and set the
 178      pending_asyncs trigger of a thread.  While the data structures
 179      are in flux, the signal handler might store the wrong handler in
 180      the cell, or set pending_asyncs of the wrong thread.  We fix this
 181      at the end by making sure that the cell has the right handler in
 182      it, if any, and that pending_asyncs is set for the new thread.
 183   */
 184
 185   /* Make sure we have a cell. */
 186   cell = SCM_VECTOR_REF (signal_handler_cells, signum);
 187   if (scm_is_false (cell))
 188     {
 189       cell = scm_cons (SCM_BOOL_F, SCM_EOL);
 190       SCM_VECTOR_SET (signal_handler_cells, signum, cell);
 191     }
 192
 193   /* Make sure it is queued for the right thread. */
 194   old_thread = SCM_VECTOR_REF (signal_handler_threads, signum);
 195   if (!scm_is_eq (thread, old_thread))
 196     {
 197       scm_root_state *r;
 198       if (scm_is_true (old_thread))
 199         {
 200           r = scm_i_thread_root (old_thread);
 201           r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs);
 202         }
 203       if (scm_is_true (thread))
 204         {
 205           r = scm_i_thread_root (thread);
 206           SCM_SETCDR (cell, r->signal_asyncs);
 207           r->signal_asyncs = cell;
 208           /* Set pending_asyncs just in case.  A signal that is
 209              delivered while we modify the data structures here might set
 210              pending_asyncs of old_thread. */
 211           r->pending_asyncs = 1;
 212         }
 213       SCM_VECTOR_SET (signal_handler_threads, signum, thread);
 214     }
 215
 216   /* Set the new handler. */
 217   if (scm_is_false (handler))
 218     {
 219       SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
 220       SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
 221     }
 222   else
 223     {
 224       SCM_VECTOR_SET (*signal_handlers, signum, handler);
 225       SCM_VECTOR_SET (signal_cell_handlers, signum,
 226                       close_1 (handler, scm_int2num (signum)));
 227     }
 228
 229   /* Now fix up the cell.  It might contain the old handler but since
 230      it is now queued for the new thread, we must make sure that the
 231      new handler is run.  Any signal that is delivered during the
 232      following code will install the new handler, so we have no
 233      problem.
 234   */
 235   if (scm_is_true (SCM_CAR (cell)))
 236     SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
 237
 238   /* Phfew.  That should be it. */
 239   return NULL;
 240 }
 241
 242 static void
 243 install_handler (int signum, SCM thread, SCM handler)
 244 {
 245   /* We block asyncs while installing the handler.  It would be safe
 246      to leave them on, but we might run the wrong handler should a
 247      signal be delivered.
 248   */
 249
 250   struct install_handler_data args;
 251   args.signum = signum;
 252   args.thread = thread;
 253   args.handler = handler;
 254   scm_c_call_with_blocked_asyncs (really_install_handler, &args);
 255 }
 256
 257 /* user interface for installation of signal handlers.  */
 258 SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 259            (SCM signum, SCM handler, SCM flags, SCM thread),
 260             "Install or report the signal handler for a specified signal.\n\n"
 261             "@var{signum} is the signal number, which can be specified using the value\n"
 262             "of variables such as @code{SIGINT}.\n\n"
 263             "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n"
 264             "CAR is the current\n"
 265             "signal hander, which will be either an integer with the value @code{SIG_DFL}\n"
 266             "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n"
 267             "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n"
 268             "signal.  The CDR contains the current @code{sigaction} flags for the handler.\n\n"
 269             "If @var{handler} is provided, it is installed as the new handler for\n"
 270             "@var{signum}.  @var{handler} can be a Scheme procedure taking one\n"
 271             "argument, or the value of @code{SIG_DFL} (default action) or\n"
 272             "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n"
 273             "was installed before @code{sigaction} was first used.  When\n"
 274             "a scheme procedure has been specified, that procedure will run\n"
 275             "in the given @var{thread}.   When no thread has been given, the\n"
 276             "thread that made this call to @code{sigaction} is used.\n"
 277             "Flags can "
 278             "optionally be specified for the new handler (@code{SA_RESTART} will\n"
 279             "always be added if it's available and the system is using restartable\n"
 280             "system calls.)  The return value is a pair with information about the\n"
 281             "old handler as described above.\n\n"
 282             "This interface does not provide access to the \"signal blocking\"\n"
 283             "facility.  Maybe this is not needed, since the thread support may\n"
 284             "provide solutions to the problem of consistent access to data\n"
 285             "structures.")
 286 #define FUNC_NAME s_scm_sigaction_for_thread
 287 {
 288   int csig;
 289 #ifdef HAVE_SIGACTION
 290   struct sigaction action;
 291   struct sigaction old_action;
 292 #else
 293   SIGRETTYPE (* chandler) (int) = SIG_DFL;
 294   SIGRETTYPE (* old_chandler) (int);
 295 #endif
 296   int query_only = 0;
 297   int save_handler = 0;
 298
 299   SCM old_handler;
 300
 301   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 302
 303 #if defined(HAVE_SIGACTION)
 304 #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
 305   /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
 306      is defined, since libguile would be likely to produce spurious
 307      EINTR errors.  */
 308   action.sa_flags = SA_RESTART;
 309 #else
 310   action.sa_flags = 0;
 311 #endif
 312   if (!SCM_UNBNDP (flags))
 313     action.sa_flags |= scm_to_int (flags);
 314   sigemptyset (&action.sa_mask);
 315 #endif
 316
 317   if (SCM_UNBNDP (thread))
 318     thread = scm_current_thread ();
 319   else
 320     {
 321       SCM_VALIDATE_THREAD (4, thread);
 322       if (scm_c_thread_exited_p (thread))
 323         SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
 324     }
 325
 326   SCM_DEFER_INTS;
 327   old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
 328   if (SCM_UNBNDP (handler))
 329     query_only = 1;
 330   else if (scm_is_integer (handler))
 331     {
 332       if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL
 333           || SCM_NUM2LONG (2, handler) == (long) SIG_IGN)
 334         {
 335 #ifdef HAVE_SIGACTION
 336           action.sa_handler = (SIGRETTYPE (*) (int)) scm_to_int (handler);
 337 #else
 338           chandler = (SIGRETTYPE (*) (int)) scm_to_int (handler);
 339 #endif
 340           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 341         }
 342       else
 343         SCM_OUT_OF_RANGE (2, handler);
 344     }
 345   else if (scm_is_false (handler))
 346     {
 347       /* restore the default handler.  */
 348 #ifdef HAVE_SIGACTION
 349       if (orig_handlers[csig].sa_handler == SIG_ERR)
 350         query_only = 1;
 351       else
 352         {
 353           action = orig_handlers[csig];
 354           orig_handlers[csig].sa_handler = SIG_ERR;
 355           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 356         }
 357 #else
 358       if (orig_handlers[csig] == SIG_ERR)
 359         query_only = 1;
 360       else
 361         {
 362           chandler = orig_handlers[csig];
 363           orig_handlers[csig] = SIG_ERR;
 364           install_handler (csig, SCM_BOOL_F, SCM_BOOL_F);
 365         }
 366 #endif
 367     }
 368   else
 369     {
 370       SCM_VALIDATE_PROC (2, handler);
 371 #ifdef HAVE_SIGACTION
 372       action.sa_handler = take_signal;
 373       if (orig_handlers[csig].sa_handler == SIG_ERR)
 374         save_handler = 1;
 375 #else
 376       chandler = take_signal;
 377       if (orig_handlers[csig] == SIG_ERR)
 378         save_handler = 1;
 379 #endif
 380       install_handler (csig, thread, handler);
 381     }
 382
 383   /* XXX - Silently ignore setting handlers for `program error signals'
 384      because they can't currently be handled by Scheme code.
 385   */
 386
 387   switch (csig)
 388     {
 389       /* This list of program error signals is from the GNU Libc
 390          Reference Manual */
 391     case SIGFPE:
 392     case SIGILL:
 393     case SIGSEGV:
 394 #ifdef SIGBUS
 395     case SIGBUS:
 396 #endif
 397     case SIGABRT:
 398 #if defined(SIGIOT) && (SIGIOT != SIGABRT)
 399     case SIGIOT:
 400 #endif
 401 #ifdef SIGTRAP
 402     case SIGTRAP:
 403 #endif
 404 #ifdef SIGEMT
 405     case SIGEMT:
 406 #endif
 407 #ifdef SIGSYS
 408     case SIGSYS:
 409 #endif
 410       query_only = 1;
 411     }
 412
 413 #ifdef HAVE_SIGACTION
 414   if (query_only)
 415     {
 416       if (sigaction (csig, 0, &old_action) == -1)
 417         SCM_SYSERROR;
 418     }
 419   else
 420     {
 421       if (sigaction (csig, &action , &old_action) == -1)
 422         SCM_SYSERROR;
 423       if (save_handler)
 424         orig_handlers[csig] = old_action;
 425     }
 426   if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN)
 427     old_handler = scm_long2num ((long) old_action.sa_handler);
 428   SCM_ALLOW_INTS;
 429   return scm_cons (old_handler, scm_from_int (old_action.sa_flags));
 430 #else
 431   if (query_only)
 432     {
 433       if ((old_chandler = signal (csig, SIG_IGN)) == SIG_ERR)
 434         SCM_SYSERROR;
 435       if (signal (csig, old_chandler) == SIG_ERR)
 436         SCM_SYSERROR;
 437     }
 438   else
 439     {
 440       if ((old_chandler = signal (csig, chandler)) == SIG_ERR)
 441         SCM_SYSERROR;
 442       if (save_handler)
 443         orig_handlers[csig] = old_chandler;
 444     }
 445   if (old_chandler == SIG_DFL || old_chandler == SIG_IGN)
 446     old_handler = scm_long2num ((long) old_chandler);
 447   SCM_ALLOW_INTS;
 448   return scm_cons (old_handler, scm_from_int (0));
 449 #endif
 450 }
 451 #undef FUNC_NAME
 452
 453 SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
 454             (void),
 455             "Return all signal handlers to the values they had before any call to\n"
 456             "@code{sigaction} was made.  The return value is unspecified.")
 457 #define FUNC_NAME s_scm_restore_signals
 458 {
 459   int i;
 460   for (i = 0; i < NSIG; i++)
 461     {
 462 #ifdef HAVE_SIGACTION
 463       if (orig_handlers[i].sa_handler != SIG_ERR)
 464         {
 465           if (sigaction (i, &orig_handlers[i], NULL) == -1)
 466             SCM_SYSERROR;
 467           orig_handlers[i].sa_handler = SIG_ERR;
 468           SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 469         }
 470 #else
 471       if (orig_handlers[i] != SIG_ERR)
 472         {
 473           if (signal (i, orig_handlers[i]) == SIG_ERR)
 474             SCM_SYSERROR;
 475           orig_handlers[i] = SIG_ERR;
 476           SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
 477         }
 478 #endif
 479     }
 480   return SCM_UNSPECIFIED;
 481 }
 482 #undef FUNC_NAME
 483
 484 SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
 485            (SCM i),
 486             "Set a timer to raise a @code{SIGALRM} signal after the specified\n"
 487             "number of seconds (an integer).  It's advisable to install a signal\n"
 488             "handler for\n"
 489             "@code{SIGALRM} beforehand, since the default action is to terminate\n"
 490             "the process.\n\n"
 491             "The return value indicates the time remaining for the previous alarm,\n"
 492             "if any.  The new value replaces the previous alarm.  If there was\n"
 493             "no previous alarm, the return value is zero.")
 494 #define FUNC_NAME s_scm_alarm
 495 {
 496   return scm_from_uint (alarm (scm_to_uint (i)));
 497 }
 498 #undef FUNC_NAME
 499
 500 #ifdef HAVE_SETITIMER
 501 SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
 502            (SCM which_timer,
 503             SCM interval_seconds, SCM interval_microseconds,
 504             SCM value_seconds, SCM value_microseconds),
 505             "Set the timer specified by @var{which_timer} according to the given\n"
 506             "@var{interval_seconds}, @var{interval_microseconds},\n"
 507             "@var{value_seconds}, and @var{value_microseconds} values.\n"
 508             "\n"
 509             "Return information about the timer's previous setting."
 510             "\n"
 511             "Errors are handled as described in the guile info pages under ``POSIX\n"
 512             "Interface Conventions''.\n"
 513             "\n"
 514             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 515             "and @code{ITIMER_PROF}.\n"
 516             "\n"
 517             "The return value will be a list of two cons pairs representing the\n"
 518             "current state of the given timer.  The first pair is the seconds and\n"
 519             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 520             "the seconds and microseconds of the timer @code{it_value}.")
 521 #define FUNC_NAME s_scm_setitimer
 522 {
 523   int rv;
 524   int c_which_timer;
 525   struct itimerval new_timer;
 526   struct itimerval old_timer;
 527
 528   c_which_timer = SCM_NUM2INT(1, which_timer);
 529   new_timer.it_interval.tv_sec = SCM_NUM2LONG(2, interval_seconds);
 530   new_timer.it_interval.tv_usec = SCM_NUM2LONG(3, interval_microseconds);
 531   new_timer.it_value.tv_sec = SCM_NUM2LONG(4, value_seconds);
 532   new_timer.it_value.tv_usec = SCM_NUM2LONG(5, value_microseconds);
 533
 534   SCM_SYSCALL(rv = setitimer(c_which_timer, &new_timer, &old_timer));
 535
 536   if(rv != 0)
 537     SCM_SYSERROR;
 538
 539   return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
 540                              scm_long2num(old_timer.it_interval.tv_usec)),
 541                     scm_cons(scm_long2num(old_timer.it_value.tv_sec),
 542                              scm_long2num(old_timer.it_value.tv_usec)));
 543 }
 544 #undef FUNC_NAME
 545 #endif /* HAVE_SETITIMER */
 546
 547 #ifdef HAVE_GETITIMER
 548 SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
 549   (SCM which_timer),
 550             "Return information about the timer specified by @var{which_timer}"
 551             "\n"
 552             "Errors are handled as described in the guile info pages under ``POSIX\n"
 553             "Interface Conventions''.\n"
 554             "\n"
 555             "The timers available are: @code{ITIMER_REAL}, @code{ITIMER_VIRTUAL},\n"
 556             "and @code{ITIMER_PROF}.\n"
 557             "\n"
 558             "The return value will be a list of two cons pairs representing the\n"
 559             "current state of the given timer.  The first pair is the seconds and\n"
 560             "microseconds of the timer @code{it_interval}, and the second pair is\n"
 561             "the seconds and microseconds of the timer @code{it_value}.")
 562 #define FUNC_NAME s_scm_getitimer
 563 {
 564   int rv;
 565   int c_which_timer;
 566   struct itimerval old_timer;
 567
 568   c_which_timer = SCM_NUM2INT(1, which_timer);
 569
 570   SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
 571
 572   if(rv != 0)
 573     SCM_SYSERROR;
 574
 575   return scm_list_2(scm_cons(scm_long2num(old_timer.it_interval.tv_sec),
 576                              scm_long2num(old_timer.it_interval.tv_usec)),
 577                     scm_cons(scm_long2num(old_timer.it_value.tv_sec),
 578                              scm_long2num(old_timer.it_value.tv_usec)));
 579 }
 580 #undef FUNC_NAME
 581 #endif /* HAVE_GETITIMER */
 582
 583 #ifdef HAVE_PAUSE
 584 SCM_DEFINE (scm_pause, "pause", 0, 0, 0,
 585            (),
 586             "Pause the current process (thread?) until a signal arrives whose\n"
 587             "action is to either terminate the current process or invoke a\n"
 588             "handler procedure.  The return value is unspecified.")
 589 #define FUNC_NAME s_scm_pause
 590 {
 591   pause ();
 592   return SCM_UNSPECIFIED;
 593 }
 594 #undef FUNC_NAME
 595 #endif
 596
 597 SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
 598            (SCM i),
 599             "Wait for the given number of seconds (an integer) or until a signal\n"
 600             "arrives.  The return value is zero if the time elapses or the number\n"
 601             "of seconds remaining otherwise.")
 602 #define FUNC_NAME s_scm_sleep
 603 {
 604   return scm_from_ulong (scm_thread_sleep (scm_to_int (i)));
 605 }
 606 #undef FUNC_NAME
 607
 608 SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
 609            (SCM i),
 610             "Sleep for @var{i} microseconds.")
 611 #define FUNC_NAME s_scm_usleep
 612 {
 613   return scm_from_ulong (scm_thread_usleep (scm_to_ulong (i)));
 614 }
 615 #undef FUNC_NAME
 616
 617 SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 618            (SCM sig),
 619             "Sends a specified signal @var{sig} to the current process, where\n"
 620             "@var{sig} is as described for the kill procedure.")
 621 #define FUNC_NAME s_scm_raise
 622 {
 623   if (kill (getpid (), scm_to_int (sig)) != 0)
 624     SCM_SYSERROR;
 625   return SCM_UNSPECIFIED;
 626 }
 627 #undef FUNC_NAME
 628
 629 \f
 630
 631 void
 632 scm_init_scmsigs ()
 633 {
 634   int i;
 635
 636   signal_handlers =
 637     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 638                                   scm_c_make_vector (NSIG, SCM_BOOL_F)));
 639   signal_handler_cells =
 640     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 641   signal_cell_handlers =
 642     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 643   signal_handler_threads =
 644     scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F));
 645
 646   for (i = 0; i < NSIG; i++)
 647     {
 648 #ifdef HAVE_SIGACTION
 649       orig_handlers[i].sa_handler = SIG_ERR;
 650
 651 #else
 652       orig_handlers[i] = SIG_ERR;
 653 #endif
 654
 655 #ifdef HAVE_RESTARTABLE_SYSCALLS
 656       /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
 657          signals really are restartable.  don't rely on the same
 658          run-time that configure got: reset the default for every signal.
 659       */
 660 #ifdef HAVE_SIGINTERRUPT
 661       siginterrupt (i, 0);
 662 #elif defined(SA_RESTART)
 663       {
 664         struct sigaction action;
 665
 666         sigaction (i, NULL, &action);
 667         if (!(action.sa_flags & SA_RESTART))
 668           {
 669             action.sa_flags |= SA_RESTART;
 670             sigaction (i, &action, NULL);
 671           }
 672       }
 673 #endif
 674       /* if neither siginterrupt nor SA_RESTART are available we may
 675          as well assume that signals are always restartable.  */
 676 #endif
 677     }
 678
 679   scm_c_define ("NSIG", scm_long2num (NSIG));
 680   scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
 681   scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
 682 #ifdef SA_NOCLDSTOP
 683   scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
 684 #endif
 685 #ifdef SA_RESTART
 686   scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
 687 #endif
 688
 689 #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER)
 690   /* Stuff needed by setitimer and getitimer. */
 691   scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
 692   scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
 693   scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
 694 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 695
 696 #include "libguile/scmsigs.x"
 697 }
 698
 699
 700 /*
 701   Local Variables:
 702   c-file-style: "gnu"
 703   End:
 704 */