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/branches/blume-private-devel/src/MLRISC/control/mlrisc-timing.sml
ViewVC logotype

Annotation of /sml/branches/blume-private-devel/src/MLRISC/control/mlrisc-timing.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1453 - (view) (download)

1 : jhr 1227 (* mlrisc-timing.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *)
5 :    
6 : monnier 245 signature MLRISC_TIMING =
7 :     sig
8 :    
9 : monnier 411 val timePhase : string -> ('a -> 'b) -> 'a -> 'b
10 : monnier 245 end
11 :    
12 : monnier 429 structure MLRiscTiming : MLRISC_TIMING =
13 : monnier 245 struct
14 :    
15 : monnier 411 fun timePhase name f =
16 : blume 1126 let val timing = MLRiscControl.timing name
17 :     val { gc, usr, sys } = !timing
18 : monnier 411 fun run x =
19 :     let val timer = Timer.startCPUTimer()
20 :     fun update timer =
21 : mblume 1453 let val t = Timer.checkGCTime timer
22 :     val gc' = #usr (#gc t)
23 :     val usr' = #usr (#nongc t)
24 :     val sys' = Time.+ (#sys (#gc t), #sys (#nongc t))
25 : monnier 411 in timing := {gc=Time.+(gc,gc'),
26 :     usr=Time.+(usr,usr'),
27 :     sys=Time.+(sys,sys')}
28 :     end
29 :     val y = f x handle e => (update timer; raise e)
30 :     in update timer; y
31 :     end
32 :     in run end
33 :    
34 : monnier 245 end

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