basis-library/mlton/rusage.sml

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure MLtonRusage: MLTON_RUSAGE =
  10    struct
  11       structure Prim = PrimitiveFFI.MLton.Rusage
  12
  13       type t = {utime: Time.time, stime: Time.time}
  14
  15       fun collect (utimeSec, utimeUsec, stimeSec, stimeUsec) =
  16          let
  17             fun toTime (sec, usec) =
  18                let
  19                   val time_sec =
  20                      Time.fromSeconds (C_Time.toLargeInt (sec ()))
  21                   val time_usec =
  22                      Time.fromMicroseconds (C_SUSeconds.toLargeInt (usec ()))
  23                in
  24                   Time.+ (time_sec, time_usec)
  25                end
  26          in
  27             {stime = toTime (stimeSec, stimeUsec),
  28              utime = toTime (utimeSec, utimeUsec)}
  29          end
  30
  31       val measureGC = MLtonGC.setRusageMeasureGC
  32
  33       val rusage =
  34          let
  35             val () = measureGC true
  36          in
  37             fn () =>
  38             let
  39                val () = Prim.getrusage ()
  40                open Prim
  41             in
  42                {children = collect (children_utime_sec, children_utime_usec,
  43                                     children_stime_sec, children_stime_usec),
  44                 gc = collect (gc_utime_sec, gc_utime_usec,
  45                               gc_stime_sec, gc_stime_usec),
  46                 self = collect (self_utime_sec, self_utime_usec,
  47                                 self_stime_sec, self_stime_usec)}
  48             end
  49          end
  50    end