Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/system/Basis/Implementation/internal-timer.sml
ViewVC logotype

Diff of /sml/trunk/src/system/Basis/Implementation/internal-timer.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1424, Tue Nov 18 21:04:35 2003 UTC revision 1425, Tue Nov 18 21:06:42 2003 UTC
# Line 16  Line 16 
16      structure Int32 = Int32Imp      structure Int32 = Int32Imp
17      structure Time = TimeImp      structure Time = TimeImp
18    
19      datatype cpu_timer = CPUT of {      type time = { usr: PB.time, sys: PB.time }
20          usr : PB.time, sys : PB.time, gc : PB.time  
21        }      datatype cpu_timer = CPUT of { nongc: time, gc: time }
22      datatype real_timer = RealT of PB.time      datatype real_timer = RealT of PB.time
23    
24      local      local
25        val gettime' : unit -> (Int32.int * int * Int32.int * int * Int32.int * int) =        val gettime' :
26              unit -> (Int32.int * int * Int32.int * int * Int32.int * int) =
27              CInterface.c_function "SMLNJ-Time" "gettime"              CInterface.c_function "SMLNJ-Time" "gettime"
28    
29        fun mkTime (s, us) =        fun mkTime (s, us) =
30            TimeImp.fromMicroseconds (1000000 * Int32.toLarge s +            Time.fromMicroseconds (1000000 * Int32.toLarge s + Int.toLarge us)
                                     Int.toLarge us)  
31      in      in
32      fun getTime () = let val (ts, tu, ss, su, gs, gu) = gettime' ()      fun getTime () = let
33            val (ts, tu, ss, su, gs, gu) = gettime' ()
34            in            in
35              { usr = mkTime(ts, tu), sys = mkTime(ss, su), gc = mkTime(gs, gu) }          { nongc = { usr = mkTime (ts, tu),
36                        sys = mkTime (ss, su) },
37              gc = { usr = mkTime (gs, gu),
38                     sys = Time.zeroTime } }
39            end            end
40      end (* local *)      end (* local *)
41    
42      fun startCPUTimer () = CPUT(getTime())      fun startCPUTimer () = CPUT(getTime())
     fun checkCPUTimer (CPUT{usr=u0, sys=s0, gc=g0}) = let  
           val {usr, sys, gc} = getTime()  
           in  
             { usr = Time.-(usr, u0),  
               sys = Time.-(sys, s0),  
               gc = Time.-(gc, g0)  
             }  
           end  
     val initCPUTime = ref(startCPUTimer ())  
     fun totalCPUTimer () = !initCPUTime  
   
43      fun startRealTimer () = RealT(Time.now())      fun startRealTimer () = RealT(Time.now())
44      fun checkRealTimer (RealT t) = Time.-(Time.now(), t)  
45        local
46            val initCPUTime = ref (startCPUTimer ())
47      val initRealTime = ref(startRealTimer ())      val initRealTime = ref(startRealTimer ())
48        in
49        fun totalCPUTimer () = !initCPUTime
50      fun totalRealTimer () = !initRealTime      fun totalRealTimer () = !initRealTime
51        fun resetTimers () =
52      fun resetTimers () = (          (initCPUTime := startCPUTimer ();
           initCPUTime := startCPUTimer ();  
53            initRealTime := startRealTimer ())            initRealTime := startRealTimer ())
54        end (* local *)
55    
56        local
57            infix -- ++
58            fun usop timeop (t: time, t': time) =
59                { usr = timeop (#usr t, #usr t'), sys = timeop (#sys t, #sys t') }
60            val op -- = usop Time.-
61            val op ++ = usop Time.+
62        in
63    
64        fun checkCPUTimer (CPUT t) = let
65            val t' = getTime ()
66        in
67            #nongc t' ++ #gc t' -- #nongc t -- #gc t
68        end
69    
70    end (* Timer *)      fun checkGCTime (CPUT t) = let
71            val t' = getTime ()
72        in
73            { nongc = #nongc t' -- #nongc t, gc = #gc t' -- #gc t }
74        end
75        end (* local *)
76    
77        fun checkRealTimer (RealT t) = Time.-(Time.now(), t)
78    
79    end (* InternalTimer *)

Legend:
Removed from v.1424  
changed lines
  Added in v.1425

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0