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

Diff of /sml/branches/idlbasis-devel/src/MLRISC/control/mlrisc-control.sml

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

revision 1231, Mon Jun 3 18:32:08 2002 UTC revision 1232, Tue Jun 4 21:11:15 2002 UTC
# Line 1  Line 1 
1    (* mlrisc-control.sml
2     *
3     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4     *)
5    
6  signature MLRISC_CONTROL =  signature MLRISC_CONTROL =
7  sig  sig
8        val registry : ControlRegistry.registry
9        val prefix : string
10        val priority : Controls.priority
11    
12      type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}      type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}
13    
# Line 7  Line 15 
15      val mlrisc_phases : string list ref        (* the optimization phases *)      val mlrisc_phases : string list ref        (* the optimization phases *)
16      val debug_stream  : TextIO.outstream ref   (* debugging output goes here *)      val debug_stream  : TextIO.outstream ref   (* debugging output goes here *)
17    
18        type 'a set = ('a, 'a ref) ControlSet.control_set
19    
20          (* Flags and counters *)          (* Flags and counters *)
21      val counters      : (string * int ref) list ref      val counters    : int set
22      val ints          : (string * int ref) list ref      val ints        : int set
23      val flags         : (string * bool ref) list ref      val flags       : bool set
24      val reals         : (string * real ref) list ref      val reals       : real set
25      val strings       : (string * string ref) list ref      val strings     : string set
26      val stringLists   : (string * string list ref) list ref      val stringLists : string list set
27      val timings       : (string * cpu_time ref) list ref      val timings     : cpu_time set
28    
29        val mkCounter    : string * string -> int ref
30        val mkInt        : string * string -> int ref
31        val mkFlag       : string * string -> bool ref
32        val mkReal       : string * string -> real ref
33        val mkString     : string * string -> string ref
34        val mkStringList : string * string -> string list ref
35        val mkTiming     : string * string -> cpu_time ref
36    
37        val counter      : string -> int ref
38        val int          : string -> int ref
39        val flag         : string -> bool ref
40        val real         : string -> real ref
41        val string       : string -> string ref
42        val stringList   : string -> string list ref
43        val timing       : string -> cpu_time ref
44    
45          (* Functions to get these *)      (* The following is the old interface.  Its use is deprecated
46         * since it does not provide documentation strings. *)
47      val getCounter    : string -> int ref      val getCounter    : string -> int ref
48      val getInt        : string -> int ref      val getInt        : string -> int ref
49      val getFlag       : string -> bool ref      val getFlag       : string -> bool ref
# Line 24  Line 51 
51      val getString     : string -> string ref      val getString     : string -> string ref
52      val getStringList : string -> string list ref      val getStringList : string -> string list ref
53      val getTiming     : string -> cpu_time ref      val getTiming     : string -> cpu_time ref
54    
55  end  end
56    
57  structure MLRiscControl : MLRISC_CONTROL =  structure MLRiscControl : MLRISC_CONTROL = struct
58  struct  
59        val priority = [10, 3]
60        val obscurity = 3
61        val prefix = "mlrisc"
62    
63        val registry = ControlRegistry.new { help = "MLRISC" }
64    
65     type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}     type cpu_time = {gc:Time.time,usr:Time.time,sys:Time.time}
66    
67     val mlrisc        = ref false      type 'a set = ('a, 'a ref) ControlSet.control_set
68     val mlrisc_phases = ref [] : string list ref  
69     val debug_stream  = ref TextIO.stdOut      val counters      = ControlSet.new () : int set
70        val ints          = ControlSet.new () : int set
71        val flags         = ControlSet.new () : bool set
72        val reals         = ControlSet.new () : real set
73        val strings       = ControlSet.new () : string set
74        val stringLists   = ControlSet.new () : string list set
75        val timings       = ControlSet.new () : cpu_time set
76    
    val counters      = ref [] : (string * int ref) list ref  
    val ints          = ref [] : (string * int ref) list ref  
    val flags         = ref [("mlrisc",mlrisc)] : (string * bool ref) list ref  
    val reals         = ref [] : (string * real ref) list ref  
    val strings       = ref [] : (string * string ref) list ref  
    val stringLists   = ref [("mlrisc-phases",mlrisc_phases)]  
                          : (string * string list ref) list ref  
    val timings       = ref [] : (string * cpu_time ref) list ref  
77     local     local
78        fun get(list,name : string,[],default) =          val timing =
79               let val r = ref default in list := (name,r) :: !list; r end              { tyName = "timing",
80          | get(list,name,(n,r)::rest,default) =                fromString = fn _ => (NONE : cpu_time option),
81               if name = n then r else get(list,name,rest,default)                toString = fn _ => "<timing>" }
82    
83            fun no x = NONE
84            fun yes x =
85                SOME (ControlUtil.EnvName.toUpper "MLRISC_" (Controls.name x))
86    
87            val nextpri = ref 0
88    
89            fun mk (set, cvt, fallback, en) (stem, descr) =
90                case ControlSet.find (set, Atom.atom stem) of
91                    SOME { ctl, info = cell } => cell
92                  | NONE => let
93                        val cell = ref fallback
94                        val p = !nextpri
95                        val ctl = Controls.control { name = stem,
96                                                     pri = [p],
97                                                     obscurity = obscurity,
98                                                     help = descr,
99                                                     ctl = cell }
100                    in
101                        nextpri := p + 1;
102                        ControlRegistry.register registry
103                            { ctl = Controls.stringControl cvt ctl,
104                              envName = en ctl };
105                        ControlSet.insert (set, ctl, cell);
106                        cell
107                    end
108     in     in
109        fun getCounter name = get(counters,name,!counters,0)          fun mkCounter x = mk (counters, ControlUtil.Cvt.int, 0, no) x
110        fun getInt name     = get(ints,name,!ints,0)          fun mkInt x = mk (ints, ControlUtil.Cvt.int, 0, yes) x
111        fun getFlag name    = get(flags,name,!flags,false)          fun mkFlag x = mk (flags, ControlUtil.Cvt.bool, false, yes) x
112        fun getReal name    = get(reals,name,!reals,0.0)          fun mkReal x = mk (reals, ControlUtil.Cvt.real, 0.0, yes) x
113        fun getString name  = get(strings,name,!strings,"")          fun mkString x = mk (strings, ControlUtil.Cvt.string, "", yes) x
114        fun getStringList name  = get(stringLists,name,!stringLists,[])          fun mkStringList x =
115        fun getTiming name  = get(timings,name,!timings,              mk (stringLists, ControlUtil.Cvt.stringList, [], yes) x
116                                   {gc =Time.zeroTime,          fun mkTiming x = mk (timings, timing, {gc =Time.zeroTime,
117                                    usr=Time.zeroTime,                                    usr=Time.zeroTime,
118                                    sys=Time.zeroTime})                                                 sys=Time.zeroTime}, no) x
119    
120            val mlrisc = mkFlag ("mlrisc", "?")
121            val mlrisc_phases = mkStringList ("phases", "MLRISC phases")
122            val debug_stream  = ref TextIO.stdOut
123     end     end
124    
125        local
126            fun find set stem =
127                case ControlSet.find (set, Atom.atom stem) of
128                    SOME { ctl, info = cell } => cell
129                  | NONE => raise Fail ("Control.MLRISC: no such control: " ^ stem)
130        in
131            val counter = find counters
132            val int = find ints
133            val flag = find flags
134            val real = find reals
135            val string = find strings
136            val stringList = find stringLists
137            val timing = find timings
138        end
139    
140        local
141            fun old_for mkFoo s = mkFoo (s, s ^ " setting")
142        in
143            val getCounter = old_for mkCounter
144            val getInt = old_for mkInt
145            val getFlag = old_for mkFlag
146            val getReal = old_for mkReal
147            val getString = old_for mkString
148            val getStringList = old_for mkStringList
149            val getTiming = old_for mkTiming
150        end
151  end  end

Legend:
Removed from v.1231  
changed lines
  Added in v.1232

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