.packageName <- "fork"
# $Id: exit.R,v 1.2 2004/05/25 19:12:26 warnes Exp $

exit <- function(status=0)
  {
    .C("Rfork__exit",
       as.integer(status),
       PACKAGE="fork")
  }
# $Id: fork.R,v 1.4 2004/05/25 19:12:32 warnes Exp $

fork <- function(slave)
  
  {
    if(missing(slave) || class(slave)!="function" && !is.null(slave) )
      stop("function for slave process to exectute must be provided.")

    pid  <- .C("Rfork_fork",
               pid=integer(1),
               PACKAGE="fork"
               )$pid

    if(pid==0)
      {
        # the slave shouldn't get a list of the master's children (?)
        if(exists(".pidlist",where="package:fork"))
          remove(".pidlist",pos="package:fork")
        
        if(!is.null(slave))
          {
            on.exit( { cat("ERROR. Calling exit()..."); exit(); }  );
            slave();
            exit();
          }
      }
    else
      {
        # save all the pid's that get created just in case the user forgets
        # to keep track of them!
        if(!exists(".pidlist",where="package:fork"))
          assign(".pidlist",pid,pos="package:fork")
        else
          assign(".pidlist",c(.pidlist, pid),pos="package:fork")
      }

    return(pid)
  }
    
# $Id: getpid.R,v 1.3 2004/05/25 19:12:32 warnes Exp $

getpid <- function()
  {
    .C("Rfork_getpid",
       pid=integer(1),
       PACKAGE="fork"
       )$pid
  }

# $Id: kill.R,v 1.4 2004/05/25 19:12:32 warnes Exp $

kill <- function(pid, signal=15)
  {
    .C("Rfork_kill",
       as.integer(pid),
       as.integer(signal),
       flag=integer(1),
       PACKAGE="fork"
       )$flag
  }

killall <- function(signal=15)
  {
    if(!exists(".pidlist",where="package:fork"))
      warning("No processes to kill, ignored.")
    for(pid in get(".pidlist",pos="package:fork"))
      kill(pid, signal)
    invisible()
  }
# %Id$

signame <- function(val)
  {
    retval <- .C("Rfork_signame",
                 name=character(1),
                 val=as.integer(val),
                 desc=character(1),
                 PACKAGE="fork")
    unlist(retval)
  }

sigval <- function(name)
  {
    name <- toupper(name)
    if( length(grep("SIG",name))!=1 )
       name <- paste("SIG", name, sep="")
    retval <- .C("Rfork_siginfo",
                 name=name,
                 val=integer(1),
                 desc=character(1),
                 PACKAGE="fork")
    unlist(retval)
  }

siglist <- function()
  {
    retval <- .Call("Rfork_siglist",
                    PACKAGE="fork")
    retval <- as.data.frame(retval)
    names(retval) <- c("name","val","desc")
    retval
  }

#siginfo <- function(val, name)
#  {
#    if(missing(val) && missing(name))
#      return(siglist())
#    else if (missing(val))
#      return(sigval(name))
#    else
#      return(signame(val))
#  }
# $Id: wait.R,v 1.3 2004/05/25 19:12:32 warnes Exp $

wait <- function(pid, nohang=FALSE, untraced=FALSE)
{
  if(missing(pid) || is.null(pid)) 
    retval <-   .C("Rfork_wait",
                   pid=integer(1),
                   status=integer(1),
                   PACKAGE="fork" )
  else
    retval <- .C("Rfork_waitpid",
                 pid = as.integer(pid),
                 as.integer(nohang),
                 as.integer(untraced),
                 status=integer(1),
                 PACKAGE="fork")

  return(c("pid"=retval$pid,
           "status"=retval$status))
}

.First.lib <- function(lib, pkg)
  {
    library.dynam("fork",pkg,lib)
  }
