basis-library/system/timer.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 Timer: TIMER =
  10    struct
  11       structure SysUsr =
  12          struct
  13             datatype t = T of {sys: Time.time, usr: Time.time}
  14
  15             fun export (T r) = r
  16
  17             fun (T {sys, usr}) - (T {sys = s', usr = u'}) =
  18                T {sys = Time.- (sys, s'),
  19                   usr = Time.- (usr, u')}
  20          end
  21
  22       type cpu_timer = {gc: SysUsr.t, self: SysUsr.t}
  23
  24       fun startCPUTimer (): cpu_timer =
  25          let
  26             val {gc = {utime = gcu, stime = gcs, ...},
  27                  self = {utime = selfu, stime = selfs}, ...} =
  28                MLtonRusage.rusage ()
  29          in
  30             {gc = SysUsr.T {sys = gcs, usr = gcu},
  31              self = SysUsr.T {sys = selfs, usr = selfu}}
  32          end
  33
  34       fun checkCPUTimes {gc, self} =
  35          let
  36             val {gc = g', self = s'} = startCPUTimer ()
  37             val gc = SysUsr.- (g', gc)
  38             val self = SysUsr.- (s', self)
  39          in
  40             {gc = SysUsr.export gc,
  41              nongc = SysUsr.export (SysUsr.- (self, gc))}
  42          end
  43
  44       fun checkCPUTimer timer =
  45          let
  46             val {nongc, gc} = checkCPUTimes timer
  47          in
  48             {sys = Time.+ (#sys gc, #sys nongc),
  49              usr = Time.+ (#usr gc, #usr nongc)}
  50          end
  51
  52       val totalCPUTimer =
  53          let
  54             val t = startCPUTimer ()
  55          in
  56             fn () => t
  57          end
  58
  59       val checkGCTime = #usr o #gc o checkCPUTimes
  60
  61       type real_timer = Time.time
  62
  63       fun startRealTimer (): real_timer = Time.now ()
  64
  65       fun checkRealTimer (t: real_timer): Time.time =
  66          Time.- (startRealTimer (), t)
  67
  68       val totalRealTimer =
  69          let
  70             val t = startRealTimer ()
  71          in
  72             fn () => t
  73          end
  74    end