child process statistics

[Dean Herington]

On Wed, 26 Feb 2003, Sigbjorn Finne wrote:

> wait3() or getrusage()? (Neither of which are supported 
> by the posix library.)
> 
> --sigbjorn

Thanks, Sigbjorn.  I drafted a Haskell wrapping of wait4(), modeled on
code I found in CVS.  See attached. I'd like a bit of help in two 
respects:

1. I found it difficult to satisfy the code requirements because I'm
building the module outside the RTS build environment.  Some issues:

 a. I don't know how to make a .hsc file, which would be the appropriate
form for the file, I think.  This meant I couldn't use #const, and may
also explain why I couldn't find the __hsunix_* routines.

 b. I had to duplicate some helper functions, including `waitOptions` and
`decipherWaitStatus`, because they didn't seem to be exported from the
module in which they're defined.

 c. I'm not sure how to define `struct timeval` and `struct rusage` so I
can avoid the kludgy code in `makeProcessResourceUsage`.

It seems that maybe I should be building in the RTS environment (and
maybe even extending the System.Posix.Process module itself) to clean
up all of the above problems.  That seems a bit daunting to me, however.

2. Having gotten my module to compile cleanly, it--not surprisingly--fails
at runtime:

invalid argument
Action: reapChildProcess
Reason: Invalid argument

Maybe a few minutes of your eyes (or those of anyone else who has delved
in the RTS) would spot the problem(s) quickly.  I tried gdb and saw what
appear to me to be reasonable arguments to wait4(), but I'm over my head
here.

Thanks in advance.

Dean


> ----- Original Message ----- 
> From: "Dean Herington" <heringto@cs.unc.edu>
> To: <glasgow-haskell-users@haskell.org>
> Sent: Wednesday, February 26, 2003 16:17
> Subject: child process statistics
> 
> 
> > Does anyone know how to get the process statistics (cputime, page faults,
> > etc.) for a child process?  When the child process has terminated, before
> > doing getAnyProcessStatus on it, I'd like to get its statistics.
> > 
> > Browsing the libraries documentation didn't turn anything up.  I couldn't
> > even find what I want at the Unix level among man pages.  (I'm happy to
> > write some FFI code to access system routines if I can locate the right
> > ones.)
> > 
> > Dean



{-# OPTIONS -fglasgow-exts #-}

-- Posix extras

-- $Id$

module PosixExtras
(
  ProcessResourceUsage(..),
  reapChildProcess
)
where

import Ratio
import System
import Posix hiding (userTime, systemTime)
import System.IO.Error
import Foreign
import Foreign.C


data ProcessResourceUsage =
     ProcessResourceUsage { userTime, systemTime :: Rational }
  deriving (Show, Read)


reapChildProcess :: Bool -> Bool -> ProcessID
        -> IO (Maybe (ProcessID, ProcessStatus, ProcessResourceUsage))
reapChildProcess block stopped pid =
  alloca $ \p_wstat ->
  allocaBytes structRusageSize $ \p_sru -> do
    pid' <- throwErrnoIfMinus1 "reapChildProcess"
              (c_wait4 (fromIntegral pid) p_wstat
                       (waitOptions block stopped) p_sru)
    case pid' of
      0 -> return Nothing
      _ -> do ps  <- decipherWaitStatus p_wstat
              pru <- makeProcessResourceUsage p_sru
              return (Just (fromIntegral pid', ps, pru))


type CPid = CInt

structRusageSize = 144  -- I think it's 72.  Include 100% slop.

type CRusage = CLong  -- cheat

makeProcessResourceUsage :: Ptr CLong -> IO ProcessResourceUsage
makeProcessResourceUsage p_sru = do
  -- Assume that ru_utime and ru_stime are at the beginning of struct rusage.
  [uhi, ulo, shi, slo] <- mapM get [0..3]
  let u = time uhi ulo
      s = time shi slo
  return $ ProcessResourceUsage{ userTime = u, systemTime = s }
 where
  get n = fmap fromIntegral $ peekElemOff p_sru n
  time hi lo = toRational hi + (lo % 1000000)

foreign import ccall unsafe "wait4"
   c_wait4 :: CPid -> Ptr CInt -> CInt -> Ptr CRusage -> IO CPid


-- The following was scarfed from
-- fptools/libraries/unix/System/Posix/Process.hsc?rev=1.4

waitOptions :: Bool -> Bool -> CInt
--             block   stopped
waitOptions False False = 1 -- (#const WNOHANG)
waitOptions False True  = 3 -- (#const (WNOHANG|WUNTRACED))
waitOptions True  False = 0
waitOptions True  True  = 2 -- (#const WUNTRACED)

-- Turn a (ptr to a) wait status into a ProcessStatus

decipherWaitStatus :: Ptr CInt -> IO ProcessStatus
decipherWaitStatus wstatp = do
  wstat <- peek wstatp
  if c_WIFEXITED wstat /= 0
      then do
        let exitstatus = c_WEXITSTATUS wstat
        if exitstatus == 0
           then return (Exited ExitSuccess)
           else return (Exited (ExitFailure (fromIntegral exitstatus)))
      else do
        if c_WIFSIGNALED wstat /= 0
           then do
                let termsig = c_WTERMSIG wstat
                return (Terminated (fromIntegral termsig))
           else do
                if c_WIFSTOPPED wstat /= 0
                   then do
                        let stopsig = c_WSTOPSIG wstat
                        return (Stopped (fromIntegral stopsig))
                   else do
                        ioError (mkIOError illegalOperationErrorType
                                   "waitStatus" Nothing Nothing)

{-

foreign import ccall unsafe "__hsunix_wifexited"
  c_WIFEXITED :: CInt -> CInt 

foreign import ccall unsafe "__hsunix_wexitstatus"
  c_WEXITSTATUS :: CInt -> CInt

foreign import ccall unsafe "__hsunix_wifsignaled"
  c_WIFSIGNALED :: CInt -> CInt

foreign import ccall unsafe "__hsunix_wtermsig"
  c_WTERMSIG :: CInt -> CInt 

foreign import ccall unsafe "__hsunix_wifstopped"
  c_WIFSTOPPED :: CInt -> CInt

foreign import ccall unsafe "__hsunix_wstopsig"
  c_WSTOPSIG :: CInt -> CInt

-}

c_WIFEXITED :: CInt -> CInt 
c_WIFEXITED c = h2c $ fromEnum $ low7 (c2h c) == 0

c_WEXITSTATUS :: CInt -> CInt
c_WEXITSTATUS c = h2c $ high8 $ c2h c

c_WIFSIGNALED :: CInt -> CInt
c_WIFSIGNALED c = h2c $ fromEnum $ c_WIFSTOPPED c /= 0 && c_WIFEXITED c /= 0

c_WTERMSIG :: CInt -> CInt 
c_WTERMSIG c = h2c $ low7 $ c2h c

c_WIFSTOPPED :: CInt -> CInt
c_WIFSTOPPED c = h2c $ fromEnum $ low8 (c2h c) == 127

c_WSTOPSIG :: CInt -> CInt
c_WSTOPSIG c = h2c $ high8 $ c2h c

low7  x = x `rem` 128
low8  x = x `rem` 256
high8 x = x `div` 256

c2h = fromIntegral
h2c = fromIntegral