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/MLRISC/control/mlrisc-control.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/control/mlrisc-control.sml

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

revision 1144, Thu Mar 14 19:53:15 2002 UTC revision 1145, Fri Mar 15 02:30:53 2002 UTC
# Line 7  Line 7 
7      val mlrisc_phases : string list ref        (* the optimization phases *)      val mlrisc_phases : string list ref        (* the optimization phases *)
8      val debug_stream  : TextIO.outstream ref   (* debugging output goes here *)      val debug_stream  : TextIO.outstream ref   (* debugging output goes here *)
9    
10  (*      type 'a entry = { stem: string, descr: string, cell: 'a ref }
11    
12          (* Flags and counters *)          (* Flags and counters *)
13      val counters      : (string * int ref) list ref      val counters    : int entry list ref
14      val ints          : (string * int ref) list ref      val ints        : int entry list ref
15      val flags         : (string * bool ref) list ref      val flags       : bool entry list ref
16      val reals         : (string * real ref) list ref      val reals       : real entry list ref
17      val strings       : (string * string ref) list ref      val strings     : string entry list ref
18      val stringLists   : (string * string list ref) list ref      val stringLists : string list entry list ref
19      val timings       : (string * cpu_time ref) list ref      val timings     : cpu_time entry list ref
20    
 *)  
21      val mkCounter    : string * string -> int ref      val mkCounter    : string * string -> int ref
22      val mkInt        : string * string -> int ref      val mkInt        : string * string -> int ref
23      val mkFlag       : string * string -> bool ref      val mkFlag       : string * string -> bool ref
# Line 46  Line 46 
46    
47  end  end
48    
49  structure MLRiscControl : MLRISC_CONTROL =  structure MLRiscControl : MLRISC_CONTROL = struct
 struct  
50     type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}     type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}
51    
52     val mlrisc        = ref false     val mlrisc        = ref false
53     val mlrisc_phases = ref [] : string list ref     val mlrisc_phases = ref [] : string list ref
54     val debug_stream  = ref TextIO.stdOut     val debug_stream  = ref TextIO.stdOut
55    
56  (*      type 'a entry = { stem: string, descr: string, cell: 'a ref }
57     val counters      = ref [] : (string * int ref) list ref  
58     val ints          = ref [] : (string * int ref) list ref      val counters      = ref [] : int entry list ref
59     val flags         = ref [("mlrisc",mlrisc)] : (string * bool ref) list ref      val ints          = ref [] : int entry list ref
60     val reals         = ref [] : (string * real ref) list ref      val flags         = ref [{ stem = "mlrisc", descr = "?", cell = mlrisc }]
61     val strings       = ref [] : (string * string ref) list ref      val reals         = ref [] : real entry list ref
62     val stringLists   = ref [("mlrisc-phases",mlrisc_phases)]      val strings       = ref [] : string entry list ref
63                           : (string * string list ref) list ref      val stringLists   = ref [{ stem = "phases", descr = "MLRISC Phases",
64     val timings       = ref [] : (string * cpu_time ref) list ref                                 cell = mlrisc_phases }]
65        val timings       = ref [] : cpu_time entry list ref
66     local     local
67        fun get(list,name : string,[],default) =          fun mk (list, fallback) (stem' : string, descr) = let
68               let val r = ref default in list := (name,r) :: !list; r end              fun loop [] =
69          | get(list,name,(n,r)::rest,default) =                  let val cell = ref fallback
              if name = n then r else get(list,name,rest,default)  
70     in     in
71        fun getCounter name = get(counters,name,!counters,0)                      list := { stem = stem', descr = descr, cell = cell }
72        fun getInt name     = get(ints,name,!ints,0)                              :: !list;
73        fun getFlag name    = get(flags,name,!flags,false)                      cell
       fun getReal name    = get(reals,name,!reals,0.0)  
       fun getString name  = get(strings,name,!strings,"")  
       fun getStringList name  = get(stringLists,name,!stringLists,[])  
       fun getTiming name  = get(timings,name,!timings,  
                                  {gc =Time.zeroTime,  
                                   usr=Time.zeroTime,  
                                   sys=Time.zeroTime})  
74     end     end
75  *)                | loop ({ stem, descr, cell } :: t) =
76                    if stem = stem' then cell else loop t
77      structure C = Controls          in
78                loop (!list)
79      val m0 = C.noconfig          end
80      val m = C.module { name = "MLRISC",      in
81                         priority = [10, 3],          fun mkCounter x = mk (counters, 0) x
82                         obscurity = 3,          fun mkInt x = mk (ints, 0) x
83                         prefix = "mlrisc-",          fun mkFlag x = mk (flags, false) x
84                         default_suffix = SOME "-default",          fun mkReal x = mk (reals, 0.0) x
85                         mk_ename = NONE }          fun mkString x = mk (strings, "") x
86            fun mkStringList x = mk (stringLists, []) x
87      val counter_r = C.registry m0 C.int          fun mkTiming x = mk (timings, {gc =Time.zeroTime,
     val int_r = C.registry m C.int  
     val flag_r = C.registry m C.bool  
     val real_r = C.registry m C.real  
     val string_r = C.registry m C.string  
     val stringList_r = C.registry m C.stringList  
     val timing_r =  
         C.registry m0 { tname = "timing",  
                         parse = fn _ => (NONE : cpu_time option),  
                         show = fn _ => "<timing>" }  
   
     fun mkCounter (stem, descr) =  
         C.new_ref counter_r { stem = stem, descr = descr, fallback = 0 }  
     fun mkInt (stem, descr) =  
         C.new_ref int_r { stem = stem, descr = descr, fallback = 0 }  
     fun mkFlag (stem, descr) =  
         C.new_ref flag_r { stem = stem, descr = descr, fallback = false }  
     fun mkReal (stem, descr) =  
         C.new_ref real_r { stem = stem, descr = descr, fallback = 0.0 }  
     fun mkString (stem, descr) =  
         C.new_ref string_r { stem = stem, descr = descr, fallback = "" }  
     fun mkStringList (stem, descr) =  
         C.new_ref stringList_r { stem = stem, descr = descr, fallback = [] }  
     fun mkTiming (stem, descr) =  
         C.new_ref timing_r { stem = stem, descr = descr,  
                              fallback = { gc = Time.zeroTime,  
88                                            usr = Time.zeroTime,                                            usr = Time.zeroTime,
89                                            sys = Time.zeroTime } }                                         sys=Time.zeroTime}) x
90        end
91    
92      val counter = C.acc_ref counter_r      local
93      val int = C.acc_ref int_r          fun find list stem' = let
94      val flag = C.acc_ref flag_r              fun loop [] =
95      val real = C.acc_ref real_r                  raise Fail ("Control.MLRISC: no such control: " ^ stem')
96      val string = C.acc_ref string_r                | loop ({ stem, descr, cell } :: t) =
97      val stringList = C.acc_ref stringList_r                  if stem = stem' then cell else loop t
98      val timing = C.acc_ref timing_r          in
99                loop (!list)
100            end
101        in
102            val counter = find counters
103            val int = find ints
104            val flag = find flags
105            val real = find reals
106            val string = find strings
107            val stringList = find stringLists
108            val timing = find timings
109        end
110    
111      local      local
112          fun old_for mkFoo s = mkFoo (s, s ^ " setting")          fun old_for mkFoo s = mkFoo (s, s ^ " setting")

Legend:
Removed from v.1144  
changed lines
  Added in v.1145

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