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