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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1233 - (view) (download)

1 : blume 1232 (* mlrisc-control.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *)
5 :    
6 : monnier 245 signature MLRISC_CONTROL =
7 :     sig
8 : blume 1232 val registry : ControlRegistry.registry
9 :     val prefix : string
10 :     val priority : Controls.priority
11 : monnier 245
12 : blume 1233 type cpu_time = {usr:Time.time,sys:Time.time}
13 : monnier 245
14 :     val mlrisc : bool ref (* use the MLRISC optimizer? *)
15 :     val mlrisc_phases : string list ref (* the optimization phases *)
16 :     val debug_stream : TextIO.outstream ref (* debugging output goes here *)
17 :    
18 : blume 1232 type 'a set = ('a, 'a ref) ControlSet.control_set
19 :    
20 : monnier 245 (* Flags and counters *)
21 : blume 1232 val counters : int set
22 :     val ints : int set
23 :     val flags : bool set
24 :     val reals : real set
25 :     val strings : string set
26 :     val stringLists : string list set
27 :     val timings : cpu_time set
28 : monnier 245
29 : blume 1232 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 :     (* The following is the old interface. Its use is deprecated
46 :     * since it does not provide documentation strings. *)
47 : monnier 245 val getCounter : string -> int ref
48 :     val getInt : string -> int ref
49 :     val getFlag : string -> bool ref
50 : leunga 657 val getReal : string -> real ref
51 : monnier 245 val getString : string -> string ref
52 : monnier 411 val getStringList : string -> string list ref
53 : monnier 245 val getTiming : string -> cpu_time ref
54 : blume 1232
55 : monnier 245 end
56 :    
57 : blume 1232 structure MLRiscControl : MLRISC_CONTROL = struct
58 : monnier 245
59 : blume 1232 val priority = [10, 3]
60 :     val obscurity = 3
61 :     val prefix = "mlrisc"
62 : monnier 245
63 : blume 1232 val registry = ControlRegistry.new { help = "MLRISC" }
64 : monnier 411
65 : blume 1233 type cpu_time = {usr:Time.time,sys:Time.time}
66 : blume 1232
67 :     type 'a set = ('a, 'a ref) ControlSet.control_set
68 :    
69 :     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 :    
77 :     local
78 :     val timing =
79 :     { tyName = "timing",
80 :     fromString = fn _ => (NONE : cpu_time option),
81 :     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
109 :     fun mkCounter x = mk (counters, ControlUtil.Cvt.int, 0, no) x
110 :     fun mkInt x = mk (ints, ControlUtil.Cvt.int, 0, yes) x
111 :     fun mkFlag x = mk (flags, ControlUtil.Cvt.bool, false, yes) x
112 :     fun mkReal x = mk (reals, ControlUtil.Cvt.real, 0.0, yes) x
113 :     fun mkString x = mk (strings, ControlUtil.Cvt.string, "", yes) x
114 :     fun mkStringList x =
115 :     mk (stringLists, ControlUtil.Cvt.stringList, [], yes) x
116 : blume 1233 fun mkTiming x = mk (timings, timing, {usr=Time.zeroTime,
117 : blume 1232 sys=Time.zeroTime}, no) x
118 :    
119 :     val mlrisc = mkFlag ("mlrisc", "?")
120 :     val mlrisc_phases = mkStringList ("phases", "MLRISC phases")
121 :     val debug_stream = ref TextIO.stdOut
122 :     end
123 :    
124 :     local
125 :     fun find set stem =
126 :     case ControlSet.find (set, Atom.atom stem) of
127 :     SOME { ctl, info = cell } => cell
128 :     | NONE => raise Fail ("Control.MLRISC: no such control: " ^ stem)
129 :     in
130 :     val counter = find counters
131 :     val int = find ints
132 :     val flag = find flags
133 :     val real = find reals
134 :     val string = find strings
135 :     val stringList = find stringLists
136 :     val timing = find timings
137 :     end
138 :    
139 :     local
140 :     fun old_for mkFoo s = mkFoo (s, s ^ " setting")
141 :     in
142 :     val getCounter = old_for mkCounter
143 :     val getInt = old_for mkInt
144 :     val getFlag = old_for mkFlag
145 :     val getReal = old_for mkReal
146 :     val getString = old_for mkString
147 :     val getStringList = old_for mkStringList
148 :     val getTiming = old_for mkTiming
149 :     end
150 : monnier 245 end

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