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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1425 - (view) (download)

1 : monnier 416 (* internal-timer.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     structure InternalTimer : sig
8 :    
9 :     include TIMER
10 :     val resetTimers : unit -> unit
11 :    
12 : mblume 1425 end = struct
13 : monnier 416
14 :     structure PB = PreBasis
15 :     structure Int = IntImp
16 :     structure Int32 = Int32Imp
17 :     structure Time = TimeImp
18 :    
19 : mblume 1425 type time = { usr: PB.time, sys: PB.time }
20 :    
21 :     datatype cpu_timer = CPUT of { nongc: time, gc: time }
22 : monnier 416 datatype real_timer = RealT of PB.time
23 :    
24 :     local
25 : mblume 1425 val gettime' :
26 :     unit -> (Int32.int * int * Int32.int * int * Int32.int * int) =
27 :     CInterface.c_function "SMLNJ-Time" "gettime"
28 :    
29 : mblume 1350 fun mkTime (s, us) =
30 : mblume 1425 Time.fromMicroseconds (1000000 * Int32.toLarge s + Int.toLarge us)
31 : monnier 416 in
32 : mblume 1425 fun getTime () = let
33 :     val (ts, tu, ss, su, gs, gu) = gettime' ()
34 :     in
35 :     { nongc = { usr = mkTime (ts, tu),
36 :     sys = mkTime (ss, su) },
37 :     gc = { usr = mkTime (gs, gu),
38 :     sys = Time.zeroTime } }
39 :     end
40 : monnier 416 end (* local *)
41 :    
42 : mblume 1425 fun startCPUTimer () = CPUT (getTime())
43 :     fun startRealTimer () = RealT (Time.now ())
44 :    
45 :     local
46 :     val initCPUTime = ref (startCPUTimer ())
47 :     val initRealTime = ref (startRealTimer ())
48 :     in
49 : monnier 416 fun totalCPUTimer () = !initCPUTime
50 :     fun totalRealTimer () = !initRealTime
51 : mblume 1425 fun resetTimers () =
52 :     (initCPUTime := startCPUTimer ();
53 :     initRealTime := startRealTimer ())
54 :     end (* local *)
55 : monnier 416
56 : mblume 1425 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 : monnier 416
64 : mblume 1425 fun checkCPUTimer (CPUT t) = let
65 :     val t' = getTime ()
66 :     in
67 :     #nongc t' ++ #gc t' -- #nongc t -- #gc t
68 :     end
69 : monnier 416
70 : mblume 1425 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 : monnier 416
77 : mblume 1425 fun checkRealTimer (RealT t) = Time.-(Time.now(), t)
78 :    
79 :     end (* InternalTimer *)

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