ocaml/otherlibs/unix/signals.c

/***********************************************************************/
/*                                                                     */
/*                           Objective Caml                            */
/*                                                                     */
/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
/*                                                                     */
/*  Copyright 1998 Institut National de Recherche en Informatique et   */
/*  en Automatique.  All rights reserved.  This file is distributed    */
/*  under the terms of the GNU Library General Public License, with    */
/*  the special exception on linking described in file ../../LICENSE.  */
/*                                                                     */
/***********************************************************************/

/* $Id$ */

#include <errno.h>
#include <signal.h>

#include <alloc.h>
#include <memory.h>
#include <mlvalues.h>
#include <signals.h>
#include "unixsupport.h"

#ifndef NSIG
#define NSIG 32
#endif

#ifdef POSIX_SIGNALS

static void decode_sigset(value vset, sigset_t * set)
{
  sigemptyset(set);
  while (vset != Val_int(0)) {
    int sig = convert_signal_number(Int_val(Field(vset, 0)));
    sigaddset(set, sig);
    vset = Field(vset, 1);
  }
}

static value encode_sigset(sigset_t * set)
{
  value res = Val_int(0);
  int i;

  Begin_root(res)
    for (i = 1; i < NSIG; i++)
      if (sigismember(set, i)) {
        value newcons = alloc_small(2, 0);
        Field(newcons, 0) = Val_int(i);
        Field(newcons, 1) = res;
        res = newcons;
      }
  End_roots();
  return res;
}

static int sigprocmask_cmd[3] = { SIG_SETMASK, SIG_BLOCK, SIG_UNBLOCK };

CAMLprim value unix_sigprocmask(value vaction, value vset)
{
  int how;
  sigset_t set, oldset;
  int retcode;

  how = sigprocmask_cmd[Int_val(vaction)];
  decode_sigset(vset, &set);
  enter_blocking_section();
  retcode = sigprocmask(how, &set, &oldset);
  leave_blocking_section();
  if (retcode == -1) uerror("sigprocmask", Nothing);
  return encode_sigset(&oldset);
}

CAMLprim value unix_sigpending(value unit)
{
  sigset_t pending;
  if (sigpending(&pending) == -1) uerror("sigpending", Nothing);
  return encode_sigset(&pending);
}

CAMLprim value unix_sigsuspend(value vset)
{
  sigset_t set;
  int retcode;
  decode_sigset(vset, &set);
  enter_blocking_section();
  retcode = sigsuspend(&set);
  leave_blocking_section();
  if (retcode == -1 && errno != EINTR) uerror("sigsuspend", Nothing);
  return Val_unit;
}

#else

CAMLprim value unix_sigprocmask(value vaction, value vset)
{ invalid_argument("Unix.sigprocmask not available"); }

CAMLprim value unix_sigpending(value unit)
{ invalid_argument("Unix.sigpending not available"); }

CAMLprim value unix_sigsuspend(value vset)
{ invalid_argument("Unix.sigsuspend not available"); }

#endif